Apple Lisa Computer Technical Information 


Apple Lisa ToolKit 3.0 


source Code Listing 


This is a listing of all the Lisa ToolKit 3.0 source code files. These files are for the most part written in Lisa Clascal, an 

object-oriented Pascal that Apple Computer created from its Lisa Pascal compiler. Other source code languages exist 

here too which includes the Lisa Workshop EXEC language (the BUILD files are in this) and various 68000 assembly 
language sources such as LIBPL/CLASLIB.TEXT. 


For detailed information about the Lisa ToolKit see Apple's extensive ToolKit documentation which includes the Lisa 
ToolKit Reference Manual, a Clascal primer, and a Toolkit tutorial. Tmagazine's 1984 article "Software Frameworks" 
which describes the ToolKit architecture and its various core classes. 
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This document contains catalog listings of the 4 disks which held all the 
source code files for the Lisa ToolKit 3.0 object library 


Document prepared by David T. Craig -- March 1993 


Pr ee re ee ee Re ee ena oe Ree eee eee eee eee eer eee ee ee ee Ree ee cee er Rear er 
| TOOLKIT SOURCE DISK # 1 

Deoe ve Joha Seren ia A eiahera eRe fe ecate rae, aie yane asm Buaher a man fare Se aka daNeAaraon 2o),a Sure vaNahs Ser Oia iat, a Sure Ua jana Sanaa: alia ove ja, iealela 
Fil ename Size Psize Last-Mod- Date Creation-Date Attr 
li bpl/ CLASLIB, TEXT 12288 24 02/06/84-11:01 02/06/84-11:01 

li bpl/ UCLASCAL. TEXT 45056 88 08/29/84-14:49 04/02/84-16:44 

|i bt k/ UABC. TEXT 69632 136 08/29/84-15:08 04/26/84-12:02 C 

li bt k/ UABC2, TEXT 93184 182 08/17/84-11:25 05/18/84-19:28 C 

li bt k/ UABC3, TEXT 66560 130 08/17/84-11:27 05/07/84-17:57 

L1 BTK/ UABC4, TEXT 61440 120 08/17/84-11:29 05/07/84-18:04 


680 total blocks for files listed 
28 blocks of OS overhead for volume and files listed 
76 blocks free out of 772 


ii ects fe, pa inc wate mht rey ce mm samy ine Gi iy tic gel yen cin eee a wee ceca ce 
| TOOLKIT SOURCE DISK # 2 

Seat eine get cea) ncaa eee ecient a cee Sasa ema eae ve eee cee 
Fil ename Size Psize Last-Mod- Date Creation-Date Attr 
LI BTK/ UABC5. TEXT 95232 186 08/17/84-11:32 05/07/84-18:03 

|i btk/ UDI ALOG. TEXT 44032 86 08/17/84-15:20 04/26/ 84-13: 23 

li btk/ UDI ALOG2. TEXT 78848 154 08/17/84-15:29 04/25/84-16:28 

li bt k/ UDI ALOG3. TEXT 61440 120 08/17/84-15:23 04/25/84-18:01 C 

li btk/ UDI ALOG4. TEXT 37888 74 04/25/84-18:58 04/25/84-18:58 

li btk/ UDRAW. TEXT 22528 44 08/29/84-15:06 05/01/84-15:07 


664 total blocks for files listed 
28 blocks of OS overhead for volume and files listed 
92 blocks free out of 772 
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000045 
000046 
000047 
000048 
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000083 
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000086 
000087 
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000089 
000090 
000091 
000092 


| TOOLKIT SOURCE DISK # 3 


li btk/ Udraw2. TEXT 
L! BTK/ UOB) ECT. TEXT 
|i bt k/ UOB) ECT2. TEXT 
li bt k/ UOB) ECT3. TEXT 
|i bt k/ UOB) ECT4. TEXT 
libtk/utext.text 
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Size Psize 
54272 106 
43008 84 
55296 108 
70656 138 
76800 150 
33792 66 


652 total blocks for files listed 
28 blocks of OS overhead for volume and 


104 blocks free out of 772 


BUI LD/ ASSEMB. TEXT 

BUI LD/ COMP. TEXT 

BUI LD/ | NSTALL. TEXT 

BUI LD/ MAKE/ ATKLIB. TEXT 
build/ make/Ctk2lib.text 
BUI LD/ MAKE/ CTKLIB. TEXT 
build/ make/Ltk2lib.text 
BUI LD/ MAKE/ LTKLIB. TEXT 
BUI LD/ MAKE/ TKLI B. TEXT 

I NTERFACE/ PASLI BC... TEXT 
I NTERFACE/ PASSWD, TEXT 

I NTERFACE/ PPASLI BC. TEXT 
LI BPL/ PASLI BCALL. OB} 

LI BPL/ PPASLI BC. OB) 

li btk/ passwd. OBJ 

li bt k/ UTEXT2. TEXT 

li bt k/ UTEXT3. TEXT 

LI BTK/ UTEXT4, TEXT 

LI BTK/ UUNI VTEXT. TEXT 

|i bt k/ XFER. TEXT 

LI BUT/ UUNI VTEXT2, TEXT 
UFI XUTEXT. TEXT 


713 total blocks for files listed 
44 blocks of OS overhead for volume and files listed 


27 blocks free out of 772 
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08/ 16/ 84- 
08/ 29/ 84- 
08/17/ 84- 
08/17/ 84- 
08/17/ 84- 
08/17/ 84- 


files listed 


12/ 12/ 83- 
08/ 16/ 84- 
08/ 16/ 84- 
02/ 02/ 84- 
02/ 24/ 84- 
08/ 16/ 84- 
08/ 16/ 84- 
08/ 16/ 84- 
08/ 27/ 84- 
11/ 13/ 85- 
11/ 13/ 85- 
11/ 13/ 85- 
04/ 04/ 84- 
04/ 04/ 84- 
08/ 16/ 84- 
08/17/ 84- 
08/17/ 84- 
08/17/ 84- 
08/ 29/ 84- 
04/ 25/ 84- 
05/ 23/ 84- 
08/ 15/ 84- 


05/07/ 84- 
05/ 16/ 84- 
05/01/ 84- 
04/ 30/ 84- 
04/ 30/ 84- 
04/ 26/ 84- 


12/12/83- 
09/ 21/ 83- 
05/ 15/ 84- 
02/02/84- 
02/ 24/ 84- 
02/ 24/ 84- 
04/ 26/ 84- 
05/01/ 84- 
02/ 24/ 84- 
11/13/85- 
11/ 13/85- 
11/ 13/85- 
04/ 04/ 84- 
04/ 04/ 84- 
08/ 16/ 84- 
04/ 25/ 84- 
05/ 21/ 84- 
05/ 21/84- 
05/ 18/ 84- 
04/ 25/ 84- 
05/ 18/ 84- 
08/ 14/ 84- 
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000093 
000094 THAT'S ALL, FOLKS ! 
000095 


End of File -- Lines: 95 Characters: 4680 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 


End of 


EXEC {Assemble a module } {filename build/assemb. text } 


{ %0 -- pathname of the module to assemble} 


$ 

${ %1 -- (optional) pathname of the resulting object file. Default name is %0} 

${ %2 -- (optional) segment name for the resulting object file. Default is ' blank 
$ 
$ 


1F %0='' THEN 
$WRITE 'File To Assembl e? 
$SREADLN %0 
$1F %l='' THEN 
$WRITE "Name For Object File [<cr> For %0]? " 
$SREADLN %1 
$1F %2='' THEN 


$WRITE 'Segment Name [<cr> For Blank Segment]? 
$SREADLN %2 
SENDI F 
SENDI F 
SENDI F 
$DEFAULT %1 to %0 
A{ssembl e} %0 {source file} 
{no listing file} 
%1 {object file} 
SIF %2<>'' THEN 
R{un}changeseg {re-assign segmentation (optional ) } 
%1 
y %2 
SENDI F 
SENDEXEC 


File -- Lines: 29 Characters: 744 
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000001 $EXEC {Compile and Code Generate a Pascal Unit} {filename build/ comp. text} 
000002 $ 

000003 ${ %0 -- pathname of the unit to compile} 

000004 ${ %1 -- (optional) pathname of the resulting object file. Defaults to %0} 

000005 ${ Destroys file ‘temp/c.i'} 

000006 ${ %2 -- (optional) pathname of intrinsic. lib. Defaults to -#boot-intrinsic. lib} 
000007 $ 

000008 $IF %0='' THEN 


000009 $WRITE 'File To Compile? 
000010 $READLN %0 


000011 $1F %l='' THEN 

000012 $WRITE "Name For Object File [<cr> For %0]? " 

000013 $SREADLN %1 

000014 $1F %2='' THEN 

000015 SWRITE 'Name Of Intrinsic. lib [<cr> For -#boot-intrinsic. lib]? 
000016 $READLN %2 

000017 SENDI F 

000018 SENDI F 


000019 $ENDIF 
000020 $DEFAULT %1 TO %0 
000021 $DEFAULT %2 TO '-#boot-intrinsic.lib' 
000022 Pascal Compile}? {option flag} 
9 


000023 %2 {intrinsic. lib} 
000024 %0 {source file} 
000025 {no listing file} 
000026 %l {object file} 
000027 $ENDEXEC 

000028 


End of File -- Lines: 28 Characters: 818 
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FILE: 


"BUILD/ INSTALL. TEXT" 


000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 


End of 


$EXEC {Install a Library in Intrinsic. lib} {filename build/install.text} 
$ 

${ %0 -- number of the library to install} 

${ %l -- (optional) pathname for input intrinsic. lib. Defaults to } 

${ -#boot-intrinsic. lib} 

${ %2 -- (optional) pathname for output intrinsic. lib. Defaults to %1} 

$ 

$1F %0='' THEN 


$WRITE 'Number Of The Library To Install? 

$READLN %0 

$1F %l='' THEN 
$WRITE 'Pathname For Input Intrinsic. lib [<cr> For -#boot-intrinsic. lib]? ' 
$SREADLN %1 
$1F %2='' THEN 


$WRITE 'Pathname For Output Intrinsic. lib [<cr> For -#boot-intrinsic. lib]? ' 


$READLN %2 
SENDI F 
SENDI F 

SENDI F 
$DEFAULT %1 TO '-#boot-intrinsic.lib' 
$DEFAULT %2 TO %1 
R{un}! Umanager 
%1 
%2 
I{nstal 1 }%0 
QY 


$ 
F{ile-MGR}B{ackup}%2, $ 
Q{uit} 

SENDEXEC 


File -- Lines: 32 Characters: 744 
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FILE: 


"BUI LD/ MAKE/ ATKLI B. TEXT" 


000001 
000002 
000003 
000004 
000005 
000006 


End of 


$EXEC {BUILD/ MAKE/ ATKLIB -- Assemble modules needed by the Toolkit} 
F{ile-Mgr}D{el ete}LI BTK/ XFER. OB] 

Y{es}Q{uit} 

$SUBMIT BUILD/ ASSEMB( LI BTK/ XFER) 

SENDEXEC 


File -- Lines: 6 Characters: 150 
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000001 $EXEC {BUILD/ MAKE/ CTKLIB -- Compile units needed by the Toolkit} 
000002 F{ile- Mgr} 

000003 D{elete}LI BTK/ UUNI VTEXT. OBJ 

000004 Y{es} 

000005 D{elete}L! BTK/ UTEXT. OBJ 

000006 Y{es} 

000007 D{elete}L! BTK/ UDI ALOG. OB} 

000008 Y{es} 

000009 Q{uit} 

000010 $SUBMIT BUILD/ COMP( LI BTK/ UUNI VTEXT) 
000011 $SUBMIT BUILD/ COMP( LI BTK/ UTEXT) 
000012 $SUBMIT BUILD/ COMP( LI BTK/ UDI ALOG) 
000013 $ENDEXEC 

000014 


End of File -- Lines: 14 Characters: 277 
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000001 $EXEC {BUILD/ MAKE/CTKLIB -- Compile units needed by the Tool kit} 
000002 F{ile-Mgr}D{el ete}LI BTK/ UOBJ ECT. OB) 
000003 Y{es} 

000004 D{elete}LI BTK/ UDRAW. OB} 

000005 Y{es} 

000006 D{elete}LI BTK/ UABC. OB) 

000007 Y{es} 

000008 Q{uit} 

000009 $SUBMIT BUILD/ COMP( LI BTK/ UOBJ ECT) 
000010 $SUBMIT BUILD/ COMP( LI BTK/ UDRAW) 
000011 $SUBMIT BUILD/ COMP( LI BTK/ UABC) 
000012 $ENDEXEC 

000013 


End of File -- Lines: 13 Characters: 267 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 


$EXEC {BUILD/ MAKE/LTKLIB -- Link the Toolkit} 
F{ile-Mgr}D{el ete}- #hoot- TK2LIB. OBJ 


Y{es}Q{uit} 

L{ink}? 

ti 

+m TKUTI nit SgTxtl ni 
+m Di gl nit SgTxtl ni 
+m DI gAlloc SgTxtl ni 
+m SgTxtHot SgTxtRes 
+m TK2Start SgParRes 
+m SgTxt Wem SgParRes 
+m Di gText SgTxtRes 
+m SgTxtCld SgTxt Two 
+m DI gDbg SgDI Adbg 
+m DI gHot SgDialog 
+m Di gRes SgDialog 
+m DI gCold SgDialog 
+m Di gWarm SgDi al og 
+m HdgMarg SgDi al og 
+m Di gLayou SgLayout 
+m TKUTWrit TKUT 

+m TKUTMai n TKUT 


L! BTK/ UUNI VTEXT 

LI BTK/ UTEXT 

L! BTK/ UDI ALOG 

- #hoot- TKLIB 

- #hoot- 1 OSPASLIB 

- #boot-SYS1LIB 

{no more input files} 
{no listing file} 

- #hoot- TK2LIB 

$SUBMIT BUILD/ 1 NSTALL(11) 
SENDEXEC 


End of File -- Lines: 35 Characters: 586 
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FILE: 


"BUILLD/ MAKE/ LTKLI B. TEXT" 


000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


$EXEC {BUILD/ MAKE/LTKLIB -- Link the Toolkit} 
F{ile-Mgr}D{el ete}- #boot-TKLI B. OBJ 
Y{es}Q{uit} 

L{ink}? 

ti 

+M SgCLAres SgABCdat 

+M SgCLAcI d SgABCdat 

+M sABCdat SgABCdat {remove} 

+M sSplit SgABCdat 

+M sRes SgDRWres 

+M sClick SgDRWres {SgABCdat} 
+M sFilter SgDRWres {SgABCdat } 
+M SgXFER SgABCres 

+M sHotUtil SgABCres {?} 

+M sStartup SgABCres 

+M sResDat SgABCres 

+M sCommand SgDRWres {SgABCdat } 
+M sCmd2 SgABCres 

+M sScroll SgABCres 

+M SLOX SgCLAi ni 

+M sError SgABCdbg 

+M Override SgCLAi ni 

+M sCldinit SgCLAdbg 

+M sinitl SgABCini 

+M sAlert SgABCcld 

+M sUtil SgCLAdbg 

+M sCut SgABCdat 

+M sPaste SgABCdat 


L! BTK/ UOB) ECT 

L! BTK/ UDRAW 

L1 BTK/ UABC 

LI BTK/ XFER 

- HBOOT- 1 OSPASLIB 

- HBOOT- | OSFPLIB 

- HBOOT- SYS1LIB 

- #BOOT- PRLIB 

{no more input files} 
{no listing file} 

- #BOOT- TKLIB 

$SUBMIT BUILD/ 1 NSTALL(10) 
SENDEXEC 
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End of File -- Lines: 43 Characters: 753 
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FILE: 


"BUI LD/ MAKE/ TKLIB, TEXT" 


000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 


End of 


$EXEC {BUI LD/ MAKE/TKLIB -- build the Toolkit} 
$SUBMIT BUILD/ ASSEMB( LI BPL/ CLASLI B) 

$SUBMIT BUILD/ COMP( LI BPL/ UCLASCAL) 

$SUBMIT BUILD/ MAKE/ ATKLIB 

$SUBMIT BUILD/ MAKE/ CTKLIB 

$SUBMIT BUILD/ MAKE/ LTKLIB 

$SUBMIT BUILD/ MAKE/ CTK2LIB 

$SUBMIT BUILD/ MAKE/ LTK2LIB 

$ENDEXEC 


File -- Lines: 9 Characters: 249 
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000001 

000002 { libpl/paslibcall interface } 

000003 

000004 intrinsic: 

000005 

000006 interface 

000007 USES 

000008 {$U libos/syscall.obj } syscall 

000009 

000010 eee ee ee ee ee eee ee eee ee eee ee eee eee ee re } 
000011 

000012 CONST 

000013 CclearScreen =; {clear the whole screen} 

000014 CclearEScreen = 23 {clear to the end of the screen} 

000015 CclearELine a3 {clear to end of line} 

000016 

000017 CgoHome = 11; {move cursor to home position} 

000018 CleftArrow = 12; {move cursor left one character position} 
000019 CrightArrow = 13; {move cursor right one character position} 
000020 CupArrow = 14; {move cursor up one line position} 

000021 CdownArrow = 15; {move cursor down one line position} 
000022 

000023 NCC eC ee ree eee eee re eT eer er ee ere ert ee eC eee Tee Eee Ter Tr ee } 
000024 

000025 function PAbortFlag : boolean; {Apple-period entered or not} 

000026 

000027 PROCEDURE GetGPrefix (Var prefix : pathname); {get global working directory} 

000028 

000029 procedure ScreenCtr (contrfun : integer); {standard screen control functions} 
000030 

000031 procedure GetPrDevice (var PrDevice : e name); 

000032 

000033 function PaslibVersion : integer; {return PASLIB version} 

000034 

000035 PROCEDURE PTranLisaChar (toTranslate : boolean); {to translate Lisa char when print} 
000036 

000037 { Optional Call To Initialize the Heap } 

000038 procedure PLINITHEAP(var ernumrefnum integer; size,delta: longint 

000039 Idsn: integer; swapable: boolean) 

000040 

000041 implementation 

000042 

000043 { FINIS } 
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000044 


End of File -- Lines: 44 Characters: 1480 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


{Provides calls for Password Protection in the Lisa Toolkit} 


ecode 
path 
passwd : 


ecode 
path 
passwd : 


ecode 
path 
refnum: 
mani p 


integer; 
pathname; 
e name ); 


integer; 
pathname; 
e name ); 


integer; 
pathname; 
integer; 
ms et ; 


{ libtk/ passwd interface } 
INTRINSIC; 
{ Copyright 1983, 1984, Apple Computer Inc. } 
INTERFACE 
USES {$U -#BOOT-SYSCALL} syscall; 
procedure MAKE SECURE ( var 
var 
var 
procedure KILL SECURE ( var 
var 
var 
procedure OPEN SECURE ( var 
var 
var 
var 


passwd : 


procedure RENAME SECURE ( var ecode 
var path 


var newName 


var passwd 


procedure VERIFY PASSWORD ( 


procedure CHANGE PASSWORD (| 


| MPLEMENTATI ON 


var ecode 
var path 
var pass 


var ecode 
var path 
var oldPa 
var newPa 


e name ); 


integer; 
pat hname; 
e_ name; 

: @ name ); 


integer; 
pat hname; 
wd : e name ); 


integer; 

pat hname; 
sswd : e name; 
sswd : e name ) 


Apple Lisa ToolKit 3.0 Source Code Listing -- 17 of 


1012 


Apple Lisa Computer Technical Information 


000044 
000045 { FINIS } 
000046 


End of File -- Lines: 46 Characters: 1416 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 


000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


{ libpl/ppaslibe i 


intrinsic; int 


nterface } 


erface 


USES {$U libos/syscall.obj } syscall; 


type 
consol edest 
dsProcCode 


dsProcParam 


{ steer Procedures called by Shell only, some by WorkShop Shell only 


PROCEDURE 
procedure 
procedure 
procedure 
procedure 


PROCEDURE 


record 
case ProcCode : dsProcCode of 


(alscreen, mainscreen, xsorocA, xsorocB, folder, sparel, spare2, spare3); { max 8 } 
(dsResProg, dsSoftPwhtn, dsPrintDev, dsSetGPrefix, dsEnbDisk, dsGet DiskEnbF) 


dsResProg : (RProcessid : longint); {must be called before 
the process starts running. } 
dsSoftPwhtn : (SPButton : boolean); {result} 


dsPrintDev : (PrDevice : e name) 


dsSetGPrefix : (errnum: INTEGER; prefix : pathname); {result} 


dsEnbDi sk : (toEnbDisk : boolean) 


dsGetDiskEnbF : (diskEnbF : boolean); {result} 


end; 


Bl ock! Ol nit; {entire blockio unit init, once per system} 


Bl ockl Odi si nit; {blockio unit clean up, called by shell only} 


lockPaslib (var errnum: integer); {lock PASLIB1 for Filer} 
lockPasiolib (var errnum: integer); {lock PASIOLIB for Filer } 
moveconsole (var errnum: integer; applconsole : consoledest); 


ExecReset (VAR errnum: INTEGER; VAR execfile : pathname 
stopexec : BOOLEAN); {open/stop exec file} 


FUNCTION ExecFlag : BOOLEAN; {return TRUE if EXEC file is active} 


PROCEDURE 


Out putRedirect (VAR errnum: INTEGER; VAR outfile : pathname 
stopoutput : BOOLEAN); {open/stop output file} 


FUNCTION OutputRFlag : BOOLEAN; {return true if output is redirected} 


procedure 


DSPaslibCall (VAR ProcParam: dsProcParam); {by Workshop Shell only} 
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000044 

000045 implementation 
000046 

000047 { FINIS } 


End of File -- Lines: 47 Characters: 2018 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 


000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


; UNIT CLASLIB; {Copyright 1 


{changed 02/06/84 1530 
{changed 01/20/84 1530 
{changed 01/18/84 0732 
{changed 01/09/84 2105 


. MACRO HEAD 
_ LF DEBUGF 
LI NK A6, #0 
MOVE.L (SP) +, A6 
» ENDC 
. ENDM 


. MACRO TAIL 
_ LF DEBUGF 
UNLK A6 
RTS 


PROC % GoLisabug 
HEAD 


; PROCEDURE % GoLisabug 


TRAP #0 
RTS 


984, Apple Computer, Inc. } 


% Method must swap in caller} 
1U) SR decoded corrected} 
Fixed BEQ bug in % Call Method & renamed it % MethodCal | } 
Separated from XFER so we can include it in PASLIB 
SgPASres: % Call Method, % Super, %GoLisaBug; 
SgPASi ni: % JmpTo, % ExitCaller, % ExitPoppingTo, % GetA5, 
% NextMethod; % InsStack 
Added an argument to % ExitPoppi ngTo} 


' 1 to include $D+ info, 0 to exclude it 


; These two instructions forma slow no-op 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 


FUN 
USE 


Apple Lisa Computer Technical 


Information 


TAIL '% GOLISA 
.FUNC % Get A5 
HEAD 
CTION % GetA5: LONGI NT; { returns register A5 } 
§ A0 
MOVE.L (SP) +, A0 ; GET RETURN ADDRESS 
MOVE.L A5, (SP) ; STORE A5 INTO RETURN SLOT 
) MP ( AQ) ; EASY, HUH? 
TAIL '% GETA5 


» PROC % Met hodCal 
HEAD 


PROCEDURE % Met hodCal |; i 


uses AQ, Al, DO, D1, D2 


157 cycles or about 32 microseconds for a regular cal 


:= Al (which has been incremented by 2) 


but we could give a better msg} 


MOVE.L (SP) +, Al +08 Al := Return Address 
TST.B (Al) ; 08 Swap in caller 
MOVE #0, DO; ;04 DO := Level Number (0-ori gin) 
MOVE.B (Al) +, D0 +08 
LSL.W #2, D0 +10 Change to a byte offset 
MOVE #0, D1; +04 D1 := Method Number (1- origin) 
MOVE.B (Al) +,D1 +08 
LSL.W #2,D1 +10 Change to a byte offset 
MOVE.L Al, - (SP) 113 Return Address 
MOVE.L 4(SP),A0 116 AQ := SELF 
. LF DEBUGF 
MOVE.L AO, D2 +04 MOVEA didn't set condition codes 
BEQ SELFNIL +08 Error if NIL (next line fails anyway, 
. ENDC 
MOVE.L (AO), A0 +12 AO := master pointer of SELF 
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000092 MOVE.L (AO), A0 +12 AO := slice table pointer of SELF's class 

000093 

000094 MOVE.L $00(A0,D0.W),A0 ;18 AO := method table pointer for the desired level 
000095 MOVE.L -4(A0,D1.W),A0 ;18 AQ := method address 

000096 

000097 ) MP ( A0) ; 08 Jump to method 

000098 

000099 SELFNIL DIVS #0, DO i **Temporary** Error report 

000100 

000101 TAIL '% METHOD 

000102 

000103 F SSS SSS SS SSS SS SSS SS Se eee ee eee ee ee ee ee ee ee ee ee ee ee ee eee ee ee ee ee ee ee ee ee ee ee eee ee eee ee ee eee eee 
000104 

000105 . PROC % SUPER 

000106 HEAD 

000107 

000108 ; PROCEDURE % Super; ; 199 cycles or about 44 microseconds for SUPERSELF (chain dist = 1) 
000109 

000110 ; uses AQ, Al, DO, D1, D2 

000111 

000112 MOVE.L (SP) +, Al +08 Al := Return Address 

000113 

000114 MOVE #0, D1 +04 D1 := Method Number (1-origin) 

000115 MOVE.B 1(SP),D1 +12 

000116 LSL.W  #2,D1 +10 Change to a byte offset 

000117 

000118 MOVE #0, DO +04 DO := Level Number (0-ori gin) 

000119 MOVE.B (SP) +, D0 +08 Increments SP by 2! 

000120 LSL.W #2, D0 +10 Change to a byte offset 

000121 

000122 MOVE.W (SP) +, D2 +08 Chain distance 

000123 MOVE.L (SP) +, A0 +12 Slice table pointer of this class 

000124 

000125 MOVE. L Al, - (SP) 113 Return Address := Al (which has not been modified) 
000126 

000127 ) MP ENDSUPL +10 

000128 

000129 SUPLOOP MOVE.L -4(A0),A0 ; 16 AO := superclass slice table pointer 

000130 ENDSUPL DBEQ D2, SUPLOOP 10-14 Loop until chain distance has been traversed (or end of chain) 
000131 

000132 MOVE.L $00(A0,D0.W),A0 ;18 AO := method table pointer for the desired level 
000133 MOVE.L -4(A0,D1.W),A0 ;18 AQ := method address 

000134 

000135 ) MP ( A0) +08 Jump to method 

000136 

000137 SELFNIL DIVS #0, DO i **Temporary** Error report 

000138 

000139 TAIL '% SUPER 
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000140 

000141 

000142 ’ eee SS SS SS SSS SS SSS SSS SSSR SS SS SSH SH SHS SSH HSS SH SSH SH SHS SSS SS SSS 
000143 . SEG 'SgPASi ni 

000144 r eee SSS SS SSS SSS SS SSS SSSR SS SS SSK SH SK SS SH HS SK SH SSH SH SH SH SSH SSS SSK 
000145 

000146 

000147 . PROC % J MPTO 

000148 HEAD 

000149 

000150 ; PROCEDURE % J mpTo( pc: LONGI NT) 

000151 

000152 = ; uses A0 

000153 

000154 MOVE.L (SP) +, A0 ; Pop Return address and ignore it 

000155 MOVE.L (SP) +, A0 ; Pop pc argument 

000156 J MP (AO) ; Jump there 

000157 

000158 TAIL "%_ J MPTO 

000159 

000160 F eee SSS SSS SS SS SS SSS SS SS SS SKS SS SSS HSH SS SH SHS SS SSH SSS SSS SSS SSK 
000161 

000162 » PROC % EXITCA 

000163 HEAD 

000164 

000165 ; PROCEDURE % ExitCaller; that is, exit the caller of my caller, undoing two LI NKs 
000166 

000167 ; modifies A6, SP 

000168 

000169 UNLK AG 

000170 UNLK AG 

000171 RTS 

000172 

000173 .1F DEBUGF 

000174 /ASCIT =‘ % EXITCA 

000175 . ENDC 

000176 

000177 F eee ee SSS SS SS SS SSS SS SS SS SS SS SS SSK HS SS SSK SH SS SSH SH SSS SS SSS SS 
000178 

000179 . PROC % EXI TPO 

000180 HEAD 

000181 

000182 ; PROCEDURE % ExitPoppingTo(newSP: LONGI NT) 

000183 ; exit my caller, and cut back the stack of the next frame to newSP 
000184 

000185 ; uses AQ, Al and modifies A6, SP 

000186 

000187 MOVE.L 4(A6),A0 ; AQ := caller's return address 
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000188 
000189 
000190 
000191 
000192 
000193 
000194 
000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
000210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
000228 
000229 
000230 
000231 
000232 
000233 
000234 
000235 


MOVE.L 4(SP), Al 
UNLK AG 

MOVE.L Al, SP 

) MP (AO) 

.1F DEBUGF 

/ASCIT = ' % EXITPO 
_ ENDC 


Apple Lisa Computer Technical 


Information 


; Al := newSP 
pop my caller's stack frame 
SP := newSP 


} FUNCTI ON 


I NTRPLP 


PSHCON 


» FUNC % Next Met hod 


HEAD 


uses AQ, Al, DO 


MOVE. L 
MOVE. L 
TST. B 


CMP. W 
BEQ 
CMP. W 
BEQ 
CMP. B 
BEQ 
CMP. W 
BEQ 
DIVS 


MOVE. W 
MOVE. B 
MOVE. L 
MOVE. W 
MOVE. W 
MOVE. B 
SUB. W 
MOVE. L 
MOVE. W 


ADD.L 
) MP 


12(SP), A0 
(AQ), Al 
(Al) 


#$4EBA, (Al) 
J SR_PC 
#$4EAD, (Al) 
JSR_AS 
#$A0, (Al) 
INT] SR 
#$3F3C, (Al) 
PSHCON 

#0, DO 


#0, DO 
2(A1), D0 
8(SP), AO 
DO, ( AO) 


#0, DO 
3(A1), DO 
#1, DO 
4(SP),A0 
DO, (AO) 


#4, Al 
| NTRPLP 
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% Next Met hod(VAR pc@l2: LONGI NT; 
VAR impLevel Number @8, i mpMet hNumber @4: 
) @16: 


INTEGER 
ProcPtr; 


@PC 

PC throughout this routine 

swap in the code to test 

test for JSR PC+d 

test for JSR d(A5) 

test for IUJSR 

test for MOVE. W 4#nn, - (SP) 

supposedly impossible 

Clear DO before loading a byte into it 

DO := the "Hi" of JSR PC+HiLo, i.e., level Number 
AO := @ evel Number 

store level Number from DO 

Clear DO before loading a byte into it 

DO := the "Lo" of JSR PC+HiLo, i.e., methodNumber 
decrement methodNumber (will be re-incremented by FINJ SR) 
AO := @met hodNumber 

store methodNumber-1 from DO 


increment PC past MOVE 
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000236 
000237 
000238 
000239 
000240 
000241 
000242 
000243 
000244 
000245 
000246 
000247 
000248 
000249 
000250 
000251 
000252 
000253 
000254 
000255 
000256 
000257 
000258 


000264 
000265 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 
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NTJ)SR MOVE.L (Al), D1 
AND. L #$FFFFFF, D1 
MOVE.L D1, A0 


FIN) SR MOVE.L AO, 16(SP) 


) 


J 


ADD.L = #4,Al 
MOVE.L 12(SP),A0 
MOVE.L Al, ( A0) 


MOVE.L 4(SP),A0 
ADD. W #1, (A0) 


MOVE.L (SP) +, A0 
ADD.L #12, SP 
) MP (A0) 


SR_PC MOVE.W 2(A1), DO 
LEA 2(A1, DO. W), AO 
) MP FIN) SR 


SR_A5 MOVE.W 2(A1),D0 
LEA 0(A5, DO. W), AO 
) MP FIN) SR 


TAIL ' %_ NEXT ME’ 


; Dl := TU) SR xxx 

; Dl := targetLocation 

; AQ := targetLocation 

; function result := targetLocation 


; increment PC past JSR 


+ @PC 


* store back incremented PC 


+ AQ := @met hodNumber 
‘ increment met hodNumber 


; DO: 
; AO: 


; DO: 
; AO: 


pop and save return address 
pop and discard arguments 
return 


the "d" of JSR PCt+d 
targetLocation 


the "d" of JSR d(A5) 
targetLocation 


» FUNC % InsStack 
HEAD 


PROCEDURE % I nsStack(addrTolnsertAt, bytesTolnsert: LONGI NT) 


This routine must be used with extreme care 
It adjusts A6, A7, and the static chain, 


exist into the moved area; that is the responsibility of the caller. 
This assumes that at least one static link needs adj ust ment 


uses AO, Al, DO, D1, D2; 


MOVE.L (SP)+, D2 
MOVE.L (SP)+,D1 
MOVE.L (SP) +, D0 


SUB.L SP, DO 
SUB.W #2, DO 
LSR.W #2, D0 


modifies 


' 02: 


' Dl 


; DO: 


: DO 


A6,A7 and static chain 


Return address 
bytesTolnsert: must be even and at least 4 
addrTolnsertAt: must be even 


how many bytes need to move 


; DO.W:= how many longs 


need to move 
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It inserts space in the middle of the stack. 
but it can not adjust other pointers that may 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 INSLP 
000292 
000293 
000294 
000295 
000296 
000297 ADJLP 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 


MOVE. L 
SUB. L 
MOVE. L 


TST. W 


MOVE. L 
DBF 


SUB. L 
MOVE. L 


SUB. L 
MOVE. L 
MOVE. L 
CMP. L 
BLT 


SP, Ad 
D1, SP 
SP, Al 


-1024( SP) 


(A0) +, (Al) + 
DO, | NSLP 


D1, A6 
A6, Al 


D1, ( Al) 
(Al), Al 
(A1), DO 
AO, DO 
ADJ LP 


D2, Al 
(Al) 


'% INSSTA' 
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+ AQ := Old SP 
+ SP := ultimate SP 
' Al := ultimate SP 


; Make the OS expand the stack if necessary 


' Move the data 


ultimate A6 
addr of first static link 


; AG r= 
; Al ie 
; adjust this static link 

' Al := addr of next static link 


If (value of that static link - first unmoved addr) 
< 0 then that static link needs adjusting, too 


DO := value of that static link 


+ Al := Return address 
; Return and Pray 


000308 ' See eee ee SSS SS SS SS SS SS SS SSS SSS SS SSS 


000309 
000310 
000311 


End of File -- 


Lines: 


311 Characters: 
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000001 


{UClasca 


ASCAL. TEXT" 
| -- In Spring '84 Release, part of PASLIB: only special units like UVOBJECT will ever USE it} 
ht 1984, Apple Computer, Inc. } 


000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


{Copyrig 
{changed 


{changed 
{changed 
{changed 
{changed 
{changed 
{changed 


{changed 
{changed 


{changed 
{changed 


{changed 
{changed 


{ RESP 


} 
{$SETC F 


04/02/84 1330 Before exiting % PGM2, see if the compiler saved A7 away, and if so 
change the value to account for the method tables on the stack. } 

02/23/84 1200 % I nObCp/Cn: Make them work before classesInitialized, too} 
02/22/84 1715 CiToCn: Make it work before classesinitialized, too} 
02/19/84 1908 SizeOfCp & CiOfCp: Make them work before classesInitialized, too} 
01/18/84 2348 LookupInHashArray returns -index instead of -1 for failure, 0 for full table} 
01/18/84 0737 Renamed % Call Method to % MethodCall so LisaBug traces mean more to people} 
01/15/84 1725 ObjectSize is always positive now, so QClassSize has been eliminated 

TOctet & TPOctets to INTERFACE} 
01/12/84 1952 Added TOctets and used it to get around signed byte bugs} 
01/12/84 1525 Added fTrcClascal to turn off extra writeLns when not debugging this unit; 

% |nObCp/Cn mask off high byte of object's stp before testing quality} 
01/11/84 1714 Fixed a bunch of bugs} 
01/11/84 1312 Added DumpArrays} 
01/10/84 2117 More moved to UObject so apps don't have to USE this unit} 
01/05/84 2141 Began Construction} 


ONSIBILITIES... 
The first class-init block is responsible for calling our procedure: 


InitClascal (PROCEDURE Finished(error: INTEGER) ) 
If no other class has already called it, then pleaselnitClascal will be TRUE, in case interested. 


If an error occurs during initialization and InitClascal has been called, we'll call: 
Finished(error); 
The error code is an OS error code, except 3333 (need a new number!!!!) is our own error 


If an error occurs during initialization and InitClascal has not been called, we 
do a Trap 0, which should get into LisaBug if present, else cause Technical Difficulties. 


Just before returning from % Pgm2, if FinishedProc is installed, we'll call 
Fi nished(0); 
which may want to copy tables from pClasses, pSTables, pAuthors, pAliases (interface globals) 


Typecast errors will also call Finished(3333) (need a new number!!!!) 


or0S := TRUE } 
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000044 UNIT UClascal 

000045 

000046 {$SETC Islntrinsic := TRUE } 
000047 

000048 {$I1FC Isintrinsic} 

000049 INTRINSIC; 

000050 {$ENDC} 


000051 

000052 INTERFACE 

000053 

000054 USES 

000055 {$U - #BO0T- SysCal | } SysCall; 

000056 

000057 

000058 {$SETC fTrcClascal := FALSE} 

000059 {$SETC fSymCl ascal := TRUE}{FALSE} 

000060 {$SETC fDbgCl ascal := TRUE}{FALSE} 

000061 

000062 

000063 {$%+} 

000064 

000065 

000066 CONST 

000067 

000068 maxClasses = 800; {Hash table sizes} 
000069 max Units = 100; 

000070 

000071 maxAuthors = 127; {Because their indices are encoded in one byte in TClassInfo} 
000072 maxAliases = 127 

000073 

000074 

000075 TYPE 

000076 

000077 TByte = -128..127; {The T-names are so programs can USE UObject, NOT USE UClascal, and use "Byte"} 
000078 TOctet = 0..255; 

000079 

000080 TOctets = PACKED ARRAY [0..32700] OF TOctet; 
000081 TPOctets = “TOctets 

000082 

000083 TS8 = STRING[ 8] 

000084 T$32 = STRING[32] 

000085 

000086 TA8 = PACKED ARRAY [1..8] OF CHAR 

000087 TA32 = PACKED ARRAY [1..32] OF CHAR 
000088 

000089 THashCompare = (cHole, cMatch, cMismatch) 
000090 

000091 TMethodArray = ARRAY [1..256] OF LONGI NT; 
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000092 
000093 
000094 
000095 
000096 
000097 
000098 
000099 
000100 
000101 
000102 
000103 
000104 
000105 
000106 
000107 
000108 
000109 
000110 
000111 
000112 
000113 
000114 
000115 
000116 
000117 
000118 
000119 
000120 
000121 
000122 
000123 
000124 
000125 
000126 
000127 
000128 
000129 
000130 
000131 
000132 
000133 
000134 
000135 
000136 
000137 
000138 
000139 


TPMet hodArray 


TSliceTable = 
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= *TMet hodArray; 


ARRAY [0..255] OF TPMethodArray; 


TPSliceTable = *TSliceTable; 

TClassinfo = RECORD {16 bytes per class} 
cl assAl pha: TA8; {Class name in this program: Exactly 8 upper-case characters} 
super! ndex: | NTEGER; {Index of my superclass in ARRAY [1..xx] OF TClassI nfo} 
objectSize: I NTEGER; {SIZEOF(an object of this class) as declared} 
classAlias: TByte; {For ToolKit: Array index, or 0 if same as classAl pha} 
companyAndAut hor: TByte; {For ToolKit: Array index, or 0 if unspecified} 
version: TByte; {For ToolKit: Version number of the object format (default=1) } 
oldestReadableVersion: TByte; {For ToolKit: Oldest version number it is capable of updating} 


END; 


{Each of the following types has only one member at run-time, and only during initialization} 


{These arrays start 


VAR 


TClassArray 
TPCl assArray 


TSTabl eArray 
TPSTabl eArray 


TAuthorArray 
TPAuthorArray 


TAliasArray 
TPAliasArray 


pleaselnitClascal 
classesinitialized: 


out small, but can grow. Each has a single pointer that is updated automatically} 


ARRAY [1..maxClasses] OF TClassinfo 
“TClassArray; 


ARRAY [1..maxClasses] OF TPSliceTable; 
“TSTabl eArray; 


ARRAY [1..maxAuthors] OF TA32; 
“TAuthor Array 


ARRAY [1..maxAliases] OF TA8 
“TAlLiasArray; 


BOOLEAN; 
BOOLEAN; 


{does InitClascal need to be called by some SUBCLASS OF NIL?} 
{has % Pgm2 compl eted?} 


pCl asses: TPClassArray; {pointer to array of TClassinfo, or NIL after % Pgm2} 
pSTabl es: TPSTableArray; {cscceevauveuveans of TPSliceTable, w..eavaaen } 
pAut hors: TPAuthorArray; {cccccevaueauevane Of “TA32;.- aati } 
pAliases: TPAliasArray; die saad each Of TAB, =«-_—-_—— nee nuns } 
pMet hods: TPMethodArray; {cscccevauveuveane of ProcPtr, = =—«—-—_sosuvaavaaes } 
li mCl asses: | NTEGER; {space allocated in pClasses* & pSTables%*} 
|i mAuthors: I NTEGER; fa tev etadah don ha ee he in pAuthors*} 
li mAliases: I NTEGER; {iis Aone Alana ate in pAliases*} 
|i mMet hods: | NTEGER; Laie ass ot wr tineas an in pMet hods *} 
numCl asses: | NTEGER; {number of elements in pClasses* & pSTables*} 
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000140 
000141 
000142 
000143 
000144 
000145 
000146 
000147 
000148 
000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
000158 
000159 
000160 
000161 
000162 
000163 
000164 
000165 
000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 
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numAut hors: INTEGER; fai trite baat aries Seed ab ae in pAuthors*} 
numAliases: I NTEGER; Ceara aera ee rarer err aera in pAliases*} 
numMet hods: | NTEGER; icine mieten cf in pMethods* ... now or last time they existed} 


{Called from class-initialization blocks} 


PROCEDURE InitClascal (PROCEDURE FinishedProc(error: INTEGER) ); {required fromfirst class-init} 
PROCEDURE QUnitAuthor(VAR companyAndAuthor: TA32); {required once per unit with Tool Kit} 
PROCEDURE QClassAuthor(VAR companyAndAuthor: TA32); {opti onal } 

PROCEDURE QClassAlias(VAR classAlias: TA8); {optional } 

PROCEDURE QClassVersion(itsVersion, oldestIltCanRead: TByte); {opti onal } 


{Called from version-conversion, allocation, and debugging code} 


PROCEDURE Ci ToCn(index: INTEGER; VAR className: TS8); {convert class index to class title $8} 
PROCEDURE CpToCn(stp: TPSliceTable; VAR className: TS8); {convert stp to class title $8} 
FUNCTION CiOfCp(stp: TPSliceTable): INTEGER; {convert stp to class index} 

FUNCTION SizeOfCp(stp: TPSliceTable): INTEGER; {convert stp to object size} 


FUNCTION Lookupl nHashArray(tbl Size: INTEGER; hashKey: LONGINT; tolnsert: BOOLEAN; 
FUNCTION Compare(index: INTEGER): THashCompare): INTEGER 
FUNCTION Call PC: LONGI NT; 


{Called by code generated by the compiler} 


PROCEDURE % Pgml; {Called before the first unit is initialized} 

PROCEDURE % Unit; {Called at the beginning of each unit-initialization bl ock} 

PROCEDURE % Class(itsClassName, itsSuperName: TS8; itsSTP: TPSliceTable; itsEvenMethods, itsOddMethods 
itsObj Size: INTEGER); {Called at the beginning of each class-initialization block} 


PROCEDURE % Pgm2; {Called after the last unit is initialized} 

{These both return their first argument if it is NIL or passes a class-membership check; else Finished(3333) } 
FUNCTION % CkObCP(ordObject, ordSTP: LONGINT): LONGI NT; {TFoo( obj), TFoo in same unit } 
FUNCTION % CkObCN(ordObj ect: LONGINT; VAR className: TS8): LONGINT; {TFoo(obj), TFoo in other unit} 


{These both return TRUE if their first arg is NON-NIL and if it passes a class-membership check} 
FUNCTION % I nObCP(ordObject, ordSTP: LONGINT): BOOLEAN; {I nClass(obj, TFoo), TFoo in same unit } 
FUNCTION % I nObCN( ordObject: LONGINT; VAR className: TS8): BOOLEAN; {InClass(obj, TFoo), TFoo in other unit} 


| MPLEMENTATI ON 
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000188 
000189 
000190 
000191 
000192 
000193 
000194 
000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
000210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
000228 
000229 
000230 
000231 
000232 
000233 
000234 
000235 


{Segments: SgPASini(tialize and Terminate) 


{$R- 
{$I F 


} 
C fSymClascal } 


{$D+} 


{$EL 
{$D- 
{$EN 


CONS 


TYPE 


SEC} 


} 
DC} 


T 


mi nCl asses 
mi nAut hors 
mi nAliases 
mi nMet hods 


growCl asses 
growAuthors 
growAliases 
growMet hods 


TS255 = STRING[ 255 


TPA8 = “TAB; 
TPA32 = *TA32; 


TBytes = ARRAY [0. 
TPBytes = “TBytes 


TWords = ARRAY [0. 
TPWords = “TWords: 


TPOctet = “TOctet; 


TPByte = “TByte 

TPint = “*INTEGER 
TPLint = “LONGI NT; 
Handle = “TPLint; 


Apple Lisa Computer Technical 


Information 


SgPASres(i dent) } 


{Initial array sizes} 


{Array growth increments (tunable) } 


]; 


.32700] OF TByte 


. 16350] OF INTEGER; 


ProcPtr = “LONGI NT 


Tl dxArray = ARRAY [0..maxClasses] OF INTEGER 


TPldxArray = “Til dxArray; 
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000236 
000237 
000238 
000239 
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000241 
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000252 
000253 
000254 
000255 
000256 
000257 
000258 
000259 
000260 
000261 
000262 
000263 
000264 
000265 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 
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TUnitArray = ARRAY [0..maxUnits] OF LONGI NT; {Element 0 is length; holes contain 0} 
TPUnitArray = “TUnitArray; 


VAR 

biggestAbstractClass: | NTEGER; {max number of methods among all entirely abstract slices, or 1} 
mAl | ocAddr: LONGI NT; {last allocated location in the method table} 
currCall Call PC: LONGI NT; {the call PC of the unit whose classes are being initted} 
pHashName: TPldxArray; {index of a class in pClasses & pSTables, or 0 for a hole} 
pHashUnit: TPUnitArray; {pc of % Unit caller, or 0 if a hole} 
p% Class: ProcPtr; {@ % Class -- a pointer to the first instruction} 
p) mp% Class: ProcPtr; {...Same, but a pointer to the jump table entry} 
pFinishedProc: ProcPtr; {@ FinishedProc passed in to InitClascal or @ DefaultFinishedProc} 
aut hor Of Unit: TByte; {Set by UnitAuthor and cleared by EndPrevi ous Unit} 
ol dNumCl asses: | NTEGER; {numClasses at the beginning of this unit's initialization} 
firstPackedName: | NTEGER; {Set in % Pgm2; see FindCn for explanation} 
dict Base: LONGI NT; {Ditto} 

{The following are assembler routines in CLASLIB. TEXT} 
FUNCTION % GetA5: LONGINT; EXTERNAL; 
FUNCTION % NextMethod(VAR pc: LONGI NT; {input and inc'd by 4 or 8} 

VAR impLevel Number, impMethNumber: INTEGER {input and output both} 
): ProcPtr; EXTERNAL; 

PROCEDURE % J mpTo(pc: LONGINT); EXTERNAL; 
PROCEDURE % ExitCaller(argBytes: INTEGER); EXTERNAL; 
PROCEDURE % ExitPoppingTo(newSP: LONGINT); EXTERNAL; 
PROCEDURE % MethodCall; EXTERNAL; 
PROCEDURE % GoLisaBug; EXTERNAL; 
PROCEDURE % InsStack(addrTolnsertAt, bytesTolnsert: LONGINT); EXTERNAL; 


{$$ SgPASres} 


FUNCTION FindCn(index: INTEGER; VAR charsApart: BOOLEAN): LONGI NT; 

{The class names starting with index=firstPackedName are stored packed below the method table, 
so the 8-character names start 8 bytes apart. 

The class names before index=firstSpreadName are stored in the unused high-order 
bytes of the method table, one every fourth byte, so the 8-character names start 
32 bytes apart. This kludge saves 1-2K of resident storage in a ToolKit application 

The name of the first class ends just before dictBase, the second class precedes it, etc.} 

VAR firstCharOffset: LONGI NT; 


BEGIN 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
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000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 
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charsApart := index < firstPackedName; 
IF charsApart THEN 

firstCharOffset := index * 32 
ELSE 


firstCharOffset := (numMethods * 4) + ((index + 1- firstPackedName) * 8); 
FindCn := dictBase - firstCharOffset 
END; 


FUNCTION CiOfCp(stp: TPSliceTable): INTEGER 
VAR index: INTEGER; 
{After init, the class index is recorded in the slice table, bytes 0 and 4 (high and low order bytes) } 
BEGIN 
Ci Of Cp := 0; 
IF classesInitialized THEN 
Ci OfCp := 256 * TPOctets(stp)*[0] + TPOctets(stp) *[ 4] 
ELSE 
FOR index := 1 TO numClasses DO 
IF pSTables*[index] = stp THEN 
Ci Of Cp : = index; 
END; 


FUNCTION SizeOfCp(stp: TPSliceTable): INTEGER; 
{After init, the size is recorded in the slice table, bytes 8 and 12, unless there are only 2 slices, } 
{..in which case the long before the slice table has a -1 in the even word and the object size 
in the odd word, instead of a superlink} 
BEGIN 
IF NOT classesInitialized THEN 
SizeOfCp := pClasses*[Ci OfCp(stp)].objectSize 
ELSE 
1F TPWords(stp)*[-2] <= 0 THEN 
SizeOfCp := TPWords(stp) *[- 1] 
LSE 


SizeOfCp := 256 * TPOctets(stp) *[8] + TPOctets(stp) *[12] 
END; 


PROCEDURE Ci ToCn(index: INTEGER; VAR className: TS8); 
VAR charsApart: BOOLEAN 
deltaAddr: INTEGER 
dictAddr: LONGI NT; 
i: INTEGER; 
classAl pha: TA8 
BEGIN 
className[0] := CHAR( 8); 
IF NOT classesInitialized THEN 
BEGIN 
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000332 
000333 
000334 
000335 
000336 
000337 
000338 
000339 
000340 
000341 
000342 
000343 
000344 
000345 
000346 
000347 
000348 
000349 
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000351 
000352 
000353 
000354 
000355 
000356 
000357 
000358 
000359 
000360 
000361 
000362 
000363 
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000367 
000368 
000369 
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000371 
000372 
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000374 
000375 
000376 
000377 
000378 
000379 
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classAl pha := pClasses*[index].classAl pha; 
FOR i := 1 TO 8 DO 
className[i] := classAl pha[i]; 
END 
ELSE 
BEGIN 
dictAddr := FindCn(index, charsApart); 
deltaAddr := 3*ORD(charsApart) + 1; 
FOR i := 1 TO 8 DO 
BEGIN 
className[i] := CHAR(TPByte(dictAddr) *); 
dictAddr := dictAddr + deltaAddr 
END; 
END; 
END; 


PROCEDURE CpToCn(stp: TPSliceTable; VAR className: TS8); 
BEGIN 

Ci ToCn(CiOfCp(stp), className); 

END; 


PROCEDURE DefaultFinishedProc(error: | NTEGER) 
BEGIN 

% GoLisabug; 
END; 


PROCEDURE Call FinishedProc( PROCEDURE Model FinishedProc(error: INTEGER); error: INTEGER); 
VAR pModel FinishedProc: TPLint 
BEGIN 
pModel FinishedProc := TPLint(ORD( @pModel FinishedProc) + 18); 
pModel FinishedProc* := ORD( pFinishedProc); 
Model FinishedProc(error); 


END; 
PROCEDURE CLAFail(error: INTEGER); {Called when fDbgClascal 
BEGIN 
IF error = 0 THEN 
error := 3333; {GET A NUMBER ASSIGNED} 
Call FinishedProc( DefaultFinishedProc, error); 
END; 


{$1 FC fDbgCl ascal } 
PROCEDURE CLABreak(s: 1TS255; n: LONGI NT); {Called when fDbgClascal is TRUE} 


is FALSE} 
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000380 BEGIN 


000381 WiteLn('CLABreak: ', s, ' =', n)} 

000382 Cl aFail(0) 

000383 END; 

000384 {$ENDC} 

000385 

000386 

000387 {Each expression "InClass(obj, TFoo)" generates: 

000388 % |nObCp(val, classPtr) or % InObCn(val, 'TFOO ') 
000389 The former ("In Object Class Pointer") is generated when TFoo is defined in the same unit 
000390 The latter ("In Object Class Name") is generated when TFoo is defined in another unit. 
000391 Both are defined bel ow} 

000392 

000393 FUNCTION % I nObCp(ordObject, ordSTP: LONGINT): BOOLEAN 
000394 TYPE PST = “TST 

000395 TST = ARRAY[0..0] OF PST; 

000396 PPST = “PST; 

000397 PPPST = “PPST; 

000398 VAR trial STP: PST; 

000399 pSTP: PPST; 

000400 BEGIN 

000401 % | nObCp : = FALSE; 

000402 IF ordObject <> 0 THEN 

000403 BEGIN 

000404 trialSTP := PPPST(ordObj ect) ** 

000405 pSTP := @trialSTP 

000406 TPByte(pSTP)* := 0; 

000407 WHILE trialSTP <> PST(ordSTP) DO 

000408 BEGIN 

000409 IF classesInitialized THEN 

000410 trialSTP := trial STP*[-1] 

000411 ELSE 

000412 trialSTP := PST (TPMethodArray(pSTables*[pClasses*[CiOfCp(TPSliceTable(trialSTP))].superl ndex])); 
000413 IF ORD(trialSTP) <= 0 THEN 

000414 EXI T( % | nObCp) 

000415 END; 

000416 % |nObCp : = TRUE; 

000417 END; 

000418 END; 

000419 

000420 

000421 FUNCTION % I nObCn(ordObject: LONGINT; VAR className: TS8): BOOLEAN 
000422 TYPE PST = “TST 

000423 TST = ARRAY[0..0] OF PST; 

000424 PPST = “PST; 

000425 PPPST = “PPST; 

000426 VAR trial STP: PST; 

000427 tryClassName: TS8 
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000428 pSTP: PPST; 

000429 BEGIN 

000430 % | nObCn : = FALSE; 

000431 IF ordObject <> 0 THEN 

000432 BEGIN 

000433 trialSTP := PPPST(ordObj ect) **; 

000434 pSTP := @trial STP; 

000435 TPByte(pSTP)* := 0; 

000436 REPEAT 

000437 CpToCn(TPSliceTable(trialSTP), tryClassName) ; 

000438 IF tryClassName = className THEN 

000439 BEGIN 

000440 % |nObCn := TRUE; 

000441 EXI T( % | nObCn) ; 

000442 END; 

000443 IF classesinitialized THEN 

000444 trialSTP := trial STP*[-1] 

000445 ELSE 

000446 trialSTP := PST(TPMethodArray(pSTables*[pClasses*[Ci Of Cp(TPSliceTable(trialSTP))].superlndex])); 
000447 UNTIL ORD(trial STP) <= 0; 

000448 END; 

000449 END; 

000450 

000451 

000452 {Each typecast expression TFoo(val) with range checking on generates: 
000453 % CkObCp(val, classPtr) or % CkObCn(val, ‘TFOO ') 

000454 The former ("Check Object Class Pointer") is generated when TFoo is defined in the same unit. 
000455 The latter ("Check Object Class Name") is generated when TFoo is defined in another unit. 
000456 Both are defined bel ow} 

000457 

000458 FUNCTION % CkObCp(ordObject, ordSTP: LONGINT): LONGI NT; 

000459 VAR obj Cl assName: TS8; 

000460 desCl assName: TS8; 

000461 BEGIN 

000462 % CkObCp : = ordObj ect; 

000463 IF ordObject <> 0 THEN 

000464 1F NOT % I nObCp(ordObj ect, ordSTP) THEN 

000465 BEGIN 

000466 CpToCn( TPSIiceTabl e( Handl e( ordObj ect) **), obj ClassName); 
000467 CpToCn(TPSliceTable(ordSTP), desClassName) ; 

000468 {$1 FC fDbgClascal } 

000469 CLABreak(CONCAT(' Attempt to coerce an object of class ', 
000470 CONCAT( obj Cl assName, 

000471 CONCAT(' to a value of type ', 
000472 desCl assName) )), 

000473 0); 

000474 {$ELSEC} 

000475 CLAFail (0); 
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000477 
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{$ENDC} 
EXI T( % CkObCp) 
END: 
END: 
FUNCTION % CkObCn(ordObj ect: LONGINT; VAR className: TS8): LONGI NT; 


VAR obj Cl assName: TS8 
BEGIN 
% CkObCn : = ordObj ect; 


IF ordObject <> 0 THEN 
1F NOT % | nObCn(ordObject, className) THEN 
BEGIN 
CpToCn( TPSIliceTabl e( Handl e( ordObj ect) **), obj Class Name) 
{$1 FC fDbgCl ascal } 
CLABreak(CONCAT(' Attempt to coerce an object of class ', 
CONCAT( obj ClassName, 
CONCAT(' to a value of type ' 
className))), 
0); 
{$ELSEC} 
CLAFail (0); 
{$ENDC} 
EXIT( % CkObCn) 
END; 
END; 
{MUST BE IN A DIFFERENT SEGMENT FROM % Class, i.e., NOT IN SgPASi ni } 


FUNCTION Get PJ mp% Class: ProcPtr 
BEGIN 

Get P] mp% Class := @% Class; 
END; 


{$$ SgPASi ni} 


PROCEDURE InitClascal (PROCEDURE FinishedProc(error: INTEGER) ); 
BEGIN 


pFinishedProc := @Fi nishedProc 
pleaselnitClascal := FALSE; 
END; 
PROCEDURE StoreCn(index: INTEGER; VAR classAl pha: TA8); 


VAR charsApart: BOOLEAN 
dictAddr: LONGI NT; 
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000524 i: | NTEGER; 

000525 BEGIN 

000526 dictAddr := FindCn(index, charsApart); 
000527 [F charsApart THEN 

000528 FOR i := 170 8 DO 

000529 BEGIN 

000530 TPByte(dictAddr)* := TByte(classAl pha[i]); 
000531 dictAddr := dictAddr + 4; 
000532 END 

000533 ELSE 

000534 TPA8(dictAddr)* := classAlpha 
000535 END; 

000536 

000537 

000538 PROCEDURE Abstract; 

000539 BEGIN 


000540 {$1 FC fDbgClascal } 

000541 CLABreak('An ABSTRACT method has been called: you can''t continue’, 0) 
000542 {$ELSEC} 

000543 CLAFai | (0) 

000544 {$ENDC} 

000545 END; 

000546 

000547 

000548 PROCEDURE InsStack(addrOfGrownArray, afterByte, bytesTolnsert: LONGI NT); 
000549 

000550 PROCEDURE AdjustPArray(VAR addrOfOtherArray: LONGINT; which: 1TS32) 
000551 BEGIN 

000552 {$1FC fTrcClascal } 

000553 Write('... ', which, ' moved from', addrOfOtherArray:12, ' to ') 
000554 {$ENDC} 

000555 1F (addrOfGrownArray + afterByte) >= addrOfOtherArray THEN 
000556 addrOfOtherArray := addrOfOtherArray - bytesTolnsert; 

000557 {$1FC fTrcClascal } 

000558 WriteLn(addrOf Ot herArray: 12) 

000559 {$ENDC} 

000560 END; 

000561 

000562 BEGIN 

000563 {$l FC fTrcClascal } 

000564 WriteLn('$$$ About to insert ', bytesTolnsert:4, ' bytes after byte ', afterByte: 3, 
000565 ' of ', addrOfGrownArray:5, '$$$'); 

000566 {$ENDC} 

000567 % InsStack(addrOfGrownArray + afterByte, bytesTolnsert); {bytesTolnsert must be even and at least 4} 
000568 Adj ust PArray(LONGINT(pAuthors), ‘pAuthors') 

000569 Adj ust PArray(LONGINT(pAliases), ‘pAliases') 

000570 Adj ust PArray(LONGINT( pClasses), ‘pClasses') 

000571 Adj ust PArray(LONGINT(pSTables), ‘pSTables') 
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Adj ust PArray(LONGINT( pMethods), 'pMethods') 

Adj ust PArray( LONGI NT( pHashName), ' pHashName' ) 
Adj ust PArray(LONGINT( pHashUnit),' pHashUnit'); 
END; 


FUNCTION MAI | ocate(numNeeded, numToGrowBy: INTEGER): LONGI NT; 
{** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING InsStack **} 
VAR numBytes: LONGI NT; 
bytesTolnsert: LONGI NT; 


BEGIN 
numBytes := 4 * numNeeded 
mAl locAddr := mAllocAddr - numBytes 


MAl locate := mAllocAddr; 
bytesTolnsert := ORD(pMethods) - mAll ocAddr 
IF bytesTolnsert > 0 THEN 


BEGIN 
IF bytesTolnsert < (4 * numToGrowBy) THEN 
bytesTolnsert := 4 * numToGrowBy 

InsStack(ORD( pMethods), 0, bytesTolnsert); 

END; 
{$l FC fTrcClascal } 
WriteLn('******* Allocated ', numNeeded:3, ' method entries at ', mAllocAddr:5, '********') 
{$ENDC} 


END; 


FUNCTION RAllocate(bytesPerRec, numNow, numToGrowBy, numRoomFor, maxNumAll owed: INTEGER; 
whutzits: TS8; ordPArray: LONGINT): INTEGER 
{** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING InsStack **} 
{bytesPerRec must be even; this function returns the new numRoomFor val ue} 
VAR bytesTolnsert: INTEGER 
BEGIN 
1F (numRoomFor + numToGrowBy) > maxNumAll owed THEN 
numtoGrowBy := maxNumAl!l owed - numRoomFor 


IF numToGrowBy <= 0 THEN 
{$1FC fDbgCl ascal } 
CLABreak(CONCAT('Too many ', whutzits), maxNumAl | owed) 
{$ELSEC} 
CLAFail (0); 
{$ENDC} 


bytesTolnsert := bytesPerRec * numToGrowBy; 
InsStack(ordPArray, bytesPerRec * numNow, bytesTolnsert); 
RAl locate := numRoomFor + numToGrowBy; 

END; 
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000620 

000621 FUNCTION LookupAuthor(VAR classAuthor: TA32): INTEGER 
000622 {There should be room for two Authors (a ClassAuthor & a UnitAuthor) because % Class checked} 
000623 VAR addr: LONGI NT; 

000624 i: INTEGER; 

000625 BEGIN 

000626 addr := ORD(pAut hors) 

000627 FOR i := 1 TO numAuthors DO 

000628 BEGIN 

000629 1F TPA32(addr)* = classAuthor THEN 
000630 BEGIN 

000631 LookupAuthor := i 

000632 EXI T( LookupAut hor); 

000633 END; 

000634 addr := addr + 32; 

000635 END; 

000636 

000637 IF numAuthors >= |imAuthors THEN 
000638 CLAFai | (0) 

000639 ELSE 

000640 BEGIN 

000641 numAuthors := numAuthors + 1; 
000642 TPA32( addr) * := classAuthor 

000643 LookupAuthor := numAuthors; 

000644 END; 

000645 END; 

000646 

000647 


000648 {** | tried merging the routines above and below, but | don't think it is worth it **} 
000649 


000650 

000651 FUNCTION LookupAlias(VAR classAlias: TA8): INTEGER 
000652 {There should be room for one alias because % Class checked} 
000653 VAR addr: LONGI NT; 

000654 i: INTEGER; 

000655 BEGIN 

000656 addr := ORD(pAliases) 

000657 FOR i := 1 TO numAliases DO 

000658 BEGIN 

000659 1F TPA8(addr)* = classAlias THEN 

000660 BEGIN 

000661 LookupAlias := i; 

000662 EXI T( LookupAlias); 

000663 END; 

000664 addr := addr + 8: 

000665 END; 

000666 

000667 IF numAliases >= limAliases THEN 
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CLAFai | (0) 

ELSE 
BEGIN 
numAliases := numAliases + 1; 
TPA8(addr)* := classAlias; 
LookupAlias := numAliases 
END; 


END; 


PROCEDURE QUnitAuthor(VAR companyAndAuthor: TA32); 


BEGIN 
IF classesInitialized THEN 
CLAFail (0); 
authorOf Unit := LookupAuthor(companyAndAut hor) 
END; 


PROCEDURE QCl assAuthor(VAR companyAndAuthor: TA32); 
BEGIN {Must call procedures before the WTH because Lookups might move pClasses*} 
IF classesInitialized THEN 
CLAFail (0); 
pClasses*[numCl asses]. companyAndAuthor := LookupAut hor(companyAndAut hor); 


PROCEDURE QClassAlias(VAR classAlias: TA8); 
BEGIN {Must call procedures before the WTH because Lookups might move pClasses*} 
IF classesinitialized THEN 
CLAFail (0); 
pClasses*[numClasses].classAlias := LookupAlias(classAlias); 
END; 


PROCEDURE QClassVersion(itsVersion, oldestItCanRead: TByte); 


BEGIN 
IF classeslnitialized THEN 
CLAFail (0); 
WTH pClasses*[numClasses] DO 
BEGIN 
version := itsVersion; 
oldestReadabl eVersion := oldestitCanRead 
END; 
END; 


FUNCTION NumSlices(classindex: INTEGER): INTEGER 
VAR n: INTEGER 
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BEGIN 
n:= 0; 
WHILE classindex > 0 DO 
BEGIN 
classindex := pClasses*[classlndex].superl ndex; 
n:i=n +2} 
END; 
NumSlices := mn 
END; 


FUNCTION Call Call PC: LONGI NT; 
VAR dummy: | NTEGER; { must be first local and two bytes long } 
BEGIN 
Call Call PC := TPLint(TPLint(TPLint(ORD( @dummy) + 2)*)* + 4)%; {caller's caller's return address} 
END; 


FUNCTION Call PC: LONGI NT; 


VAR dummy: | NTEGER; { must be first local and two bytes long } 
BEGIN 
Call PC := TPLint(TPLint(ORD( @dummy) + 2)* + 4)%; {caller's return address} 


END; 


PROCEDURE SetCal!PC(pc: LONGI NT); 
VAR dummy: | NTEGER; { must be first local and two bytes long } 
addr Of PC: LONGI NT; 


BEGIN 

addrOfPC := TPLint(ORD( @dummy) + 2)* + 4; 

TPLint(addrOfPC)* := pc; {caller's return address} 
END; 


FUNCTION LookupInHashArray(tbl Size: INTEGER; hashKey: LONGINT; tolnsert: BOOLEAN 
FUNCTION Compare(index: INTEGER): THashCompare): INTEGER 
{tolnsert, return: -index if entry already there, index (>0) if a hole found} 
{not tolnsert, return: index (> 0) if entry found, -index if not there} 
{return 0 if table is full} 


VAR probe: INTEGER 
origProbe: INTEGER 
hashCompare: THashCompare 
BEGIN {This could be made faster -- and probably should be} 


LookupI nHashArray := 0 

probe := hashKey; 

probe := (ABS(probe) MOD tbl Size) + 1; 
origProbe := probe; 

REPEAT 
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000764 hashCompare := Compare( probe); 

000765 IF hashCompare <> cMismatch THEN 
000766 BEGIN 

000767 IF tolnsert = (hashCompare = cHole) THEN 
000768 LookupI nHashArray := probe 
000769 ELSE 

000770 Lookup! nHashArray := - probe; 
000771 EXI T( Lookupl nHashArray); 

000772 END; 

000773 probe := probe + 1; 

000774 IF probe > tblSize THEN 

000775 probe := 1; 

000776 UNTIL probe = origProbe; 

000777 END; 

000778 

000779 


000780 {$IFC fTrcClascal } 
000781 PROCEDURE DumpArrays; 


000782 VAR index: INTEGER; 

000783 itsSTP: TPSliceTable: 

000784 slices: INTEGER; 

000785 S: TS8; 

000786 j: INTEGER; 

000787 i: INTEGER; 

000788 level: INTEGER; 

000789 methArrPtr: TPMet hodArray; 

000790 numAtThatLevel: INTEGER; 

000791 BEGIN 

000792 WiteLn; 

000793 WriteLn(' KKKKKKKKKEKKKKK ARRAYS KKKKKKKKKKKKKKE '); 
000794 WiteLn; 

000795 FOR index := 1 TO numClasses DO 

000796 BEGIN 

000797 Write('Class Index = ', index:3); 

000798 itsSTP := pSTables*[index]; 

000799 Write(' Class Pointer = ', ORD(itsSTP): 10); 
000800 slices := NumSlices(index); 

000801 Write(' Number of slices = ', slices:3); 
000802 s[0] := CHAR( 8); 

000803 FOR j := 1 TO 8 DO 

000804 s[j] := pClasses*[index].classAl pha[j]; 
000805 WriteLn(' Name =', Ss); 

000806 i := index; 

000807 FOR level := slices - 1 DOWNTO 0 DO 

000808 BEGIN 

000809 Write(' Level ', level:1); 

000810 Write(' Index ', i:2); 

000811 
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000812 
000813 
000814 
000815 
000816 
000817 
000818 
000819 
000820 
000821 
000822 
000823 
000824 
000825 
000826 
000827 
000828 
000829 
000830 
000831 
000832 
000833 
000834 
000835 
000836 
000837 
000838 
000839 
000840 
000841 
000842 
000843 
000844 
000845 
000846 
000847 
000848 
000849 
000850 
000851 
000852 
000853 
000854 
000855 
000856 
000857 
000858 
000859 
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methArrPtr := itsSTP*[level]; 
Write(' Method array ptr = ', ORD(methArrPtr): 10) 


numAtThatLevel := TPWords(pSTables*[i]) *[ ORD( ODD(I evel ))-2] 


Write(' numAtThatLevel ', numAtThatLevel: 2) 
1F methArrPtr = NIL THEN 

WriteLn(', ... all Abstract') 
ELSE 

BEGIN 

WriteLn; 


FOR j := 1 TO numAtThatLevel DO 
WriteLn(j:10, ORD( methArrPtr*[j]):10); 
END; 


1F NOT ODD(!l evel) THEN 
i := pClasses*[i].superl ndex; 


WriteLn; 
END; 
WriteLn; 
END; 
END; 
{$ENDC} 


{The main program starts with: 


1!!} 
It! } 
It! } 
1!!} 
1!!} 


e.g., pMethods} 


JSR % Pgml ; Defined below 

JSR unit #m ; for every unit USEd by the main program within $CLASSES+ (in order USEd)... 

JSR unit #n 

JSR % Pgm2 ; Defined bel ow} 

PROCEDURE % Pgml; 

VAR methads: ARRAY [1..minMethods] OF ProcPtr; {!!! MUST MUST MUST be the first VAR 
aliases: ARRAY [1..minAliases] OF TA8; {!!! Should be in this group of VARs 
authors: ARRAY [1..minAuthors] OF TA32; {!!! Should be in this group of VARs 
sTables: ARRAY [1..minClasses] OF TPSliceTable;{!!! Should be in this group of VARs 
classes: ARRAY [1..minClasses] OF TClassinfo; {!!! Should be in this group of VARs 

{The arrays above can grow; only one ptr to each is maintained in a global variable, 
excepName: T_Ex_Name; {These all stay allocated until the end of % Pgm2} 
error: INTEGER; 
addr: LONGI NT; 

i: | NTEGER; 
hashUnit: TUnitArray 
hashName: TldxArray; 


BEGIN 
{Install Default Finished procedure} 
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000860 pFinishedProc := @DefaultFinished 

000861 

000862 {Initialize global interface variables} 

000863 

000864 pleaselnitClascal := TRUE; {A global set to FALSE in InitClascal } 
000865 classesInitialized := FALSE; {A global set TRUE in % Pgm2} 

000866 

000867 pClasses := @classes 

000868 pSTables := @sTables 

000869 pAuthors := @authors 

000870 pAliases := @aliases 

000871 pMethods := @methads; {methads spelled funny because METHODS is a reserved word} 
000872 {NOTE: pMethods*[] is never written; the "ARRAY" can be > 32K bytes if necessary} 
000873 

000874 limClasses := minClasses; 

000875 limAuthors := minAuthors; 

000876 limAliases := minAliases; 

000877 limMethods := minMethods; 

000878 

000879 numClasses := 0; {incremented by % Class} 

000880 numAuthors := 0; {never modified in this unit; UOBJECT manages them} 
000881 numAliases := 0; {never modified in this unit; UOBJECT manages them} 
000882 numMethods := 0; {incremented by FillArraysFrom, called by % Class} 
000883 

000884 {Set the scheduling mode} 

000885 Sched Class(error, TRUE); 

000886 IF error > 0 THEN 

000887 CLAFail (error); 

000888 

000889 {Set six bytes at 0(A5) to J MP % MethodCall in XFER} 

000890 addr := % GetA5; 

000891 TPlnt(addr)* := $4EF9; {J MP full Addr} 

000892 addr := addr + 2: 

000893 TPLint(addr)* := ORD( @% Met hodCall); 

000894 

000895 {Clear hash tables} 

000896 FOR i := 1 TO maxUnits DO 

000897 hashUnit[i] := 0; 

000898 FOR i := 1 TO maxClasses DO 

000899 hashName[i] := 0; 

000900 

000901 {Initialize global implementation variables} 

000902 

000903 pHas hName = @hashName 

000904 pHashUni t = @hashUnit; 

000905 

000906 authorOf Unit := 0; 

000907 mAl locAddr := ORD(pMethods) + limMethods * 4 
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000908 biggestAbstractClass := 1; {Could be 0, but this produces a more comprehensible memory dump} 
000909 currCall Call PC := 0; 

000910 

000911 p% Class = @% Class; {The % NextMethod loop in % Class stops at a JSR % Class} 

000912 p) mp% Class := GetP)mp% Class; {A function in another segment must get the jump table address for me} 
000913 

000914 {We can never return because we need our locals around during the unit initializations and need 
000915 the method tables around forever} 

000916 % J mpTo( Cal | PC) 

000917 END; 

000918 

000919 


000920 PROCEDURE EndPreviousUnit; {We don't require companyAndAuthor--but client could do so at the end of % Pgm2} 
000921 VAR i: INTEGER 
000922 BEGIN 


000923 IF authorOfUnit <> 0 THEN 

000924 FOR i := oldNumClasses + 1 TO numClasses DO 
000925 WITH pClasses*[i] DO 

000926 1F companyAndAuthor = 0 THEN 

000927 companyAndAuthor := authorOf Unit; 
000928 authorOf Unit := 0; 

000929 ol dNumCl asses := numClasses 

000930 END; 

000931 

000932 

000933 PROCEDURE % Pgm2; 

000934 {** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING MAllocate **} 
000935 VAR dummy: LONGI NT; {MUST BE FIRST VAR AND 4 BYTES LONG!!! } 
000936 pAbstracts: TPMet hodArray; 

000937 index: INTEGER; 

000938 extraLongs: LONGI NT; 

000939 itsSTP: TPSliceTable: 

000940 slices: INTEGER; 

000941 level: INTEGER; 

000942 obj Size: INTEGER 

000943 pint: TPiI nt; 

000944 pLint: TPLint; 

000945 BEGIN 

000946 EndPrevi ousUnit; 

000947 


000948 {For any slice that was fully abstract, we will make it point at a special block of @ Abstract} 


000949 pAbstracts := TPMethodArray(MAllocate(biggestAbstractClass, 16)) 
000950 numMethods := numMethods + biggestAbstractClass 

000951 FOR index := 1 TO biggestAbstractClass DO 

000952 pAbstracts*[index] := ORD(@ _Abstract); 

000953 

000954 {Assure sufficient room for names} 

000955 dictBase := mAllocAddr + (numMethods * 4) 
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000956 firstPackedName := (numMethods DIV 8) + 1; 

000957 extraLongs := 2 * (numClasses - firstPackedName + 1) 

000958 IF extraLongs > 0 THEN 

000959 dummy := MAllocate(extraLongs, 0) 

000960 

000961 {$1 FC fTrcClascal } 

000962 WriteLn('biggestAbstractClass = ', biggestAbstractClass: 6); 

000963 WriteLn('numMethods allocated = ', numMethods:6); 

000964 WiteLn('firstPackedName = ', firstPackedName: 6); 

000965 WriteLn('extraLlongs = ', extraLlongs: 6); 

000966 WriteLn(' mAll ocAddr = ', mAllocAddr:6); 

000967 WiteLn('dictBase = ', dictBase:6); 

000968 WriteLn(' pClasses = ', ORD(pClasses):6); 

000969 WriteLn(' pSTables = ', ORD( pSTables):6); 

000970 {$ENDC} 

000971 

000972 {Search back fromcall to % PGM2 for a MOVE.L A7, xxxx(A5) (opcode $2B4F); if found, calculate the 
000973 address that contains the saved A7 and stuff in mAllocAddr instead. Stop searching if we 
000974 find a LINK A5, xxxx instruction, } 

000975 pLint := Pointer(Ord(@dummy) + 8); {pLint* should be our return address} 

000976 plnt := Pointer(pLint%*); 

000977 

000978 WHILE (pl nt* <> $2B4F {MOVE.L A7, xxxx(A5)}) AND (plnt* <> $4655 {LINK A5, xxxx}) DO 

000979 pl nt := Pointer(Ord(plnt) - 2); 

000980 IF plnt* = $2B4F THEN 

000981 BEGIN 

000982 pl nt := Pointer(Ord(plnt) + 2) 

000983 pLint := Pointer(plnt* + % GetA5) 

000984 pLint* := mAllocAddr; 

000985 END; 

000986 

000987 {Final initialization of each class in turn} 

000988 FOR index := 1 TO numClasses DO 

000989 BEGIN 

000990 {Fill in missing slices} 

000991 itsSTP := pSTables*[index] 

000992 slices := NumSlices(index); 

000993 FOR level := 0 TO slices - 1 DO 

000994 IF itsSTP*[level] = NIL THEN 

000995 itsSTP*[level] := pAbstracts 

000996 

000997 {Copy the name to the method table area} 

000998 StoreCn(index, pClasses*[index].classAl pha) 

000999 

001000 {The class index is recorded in the slice table, bytes 0 and 4 (high and low order bytes) } 
001001 {The object size is recorded in the slice table, bytes 8 and 12, unless there are only two slices, } 
001002 {..in which case the long before the slice table has a -1 in the even word and the object size 
001003 in the odd word, instead of a superlink} 
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001004 

001005 obj Size := pClasses*[index]. obj ectSize 

001006 IF slices > 2 THEN 

001007 BEGIN 

001008 TPOctets(itsSTP) *[ 8] = TPOctets( @obj Size) *[0] 
001009 TPOctets(itsSTP)*[12] := TPOctets(@obj Size) *[1] 
001010 itsSTP*[-1] := TPMethodArray(pSTables*[pClasses*[index].superl ndex]); 
001011 END 

001012 ELSE 

001013 BEGIN 

001014 TPWords(itsSTP)*[-2] := -1; 

001015 TPWords(itsSTP)*[-1] := obj Size 

001016 END; 

001017 

001018 TPOctets(itsSTP) *[0] := TPOctets( @i ndex) *[0] 

001019 TPOctets(itsSTP) *[4] := TPOctets( @i ndex) *[1] 

001020 END; 

001021 

001022 {Report success to higher levels and let it copy the tables it may desire before we destroy them} 
001023 Call FinishedProc(DefaultFinishedProc, 0) 

001024 pCl asses := NIL; 

001025 pSTables = NIL; 

001026 pAut hors = NIL; 

001027 pAliases = NIL; 

001028 pMet hods = NIL; 

001029 

001030 {Just to keep things clean and consistent} 

001031 pHas hName = NIL; 

001032 pHashUni t = NIL; 

001033 

001034 {Disable UnitAuthor, ClassAuthor, ClassVersion, ClassSize, and FinishedProc} 
001035 classesinitialized := TRUE: 

001036 


001037 {Exit from % Pgml, finally freeing its local storage below the TMethodArray} 
001038 % Exit Poppi ngTo( mAl | ocAddr) 


001039 END 

001040 

001041 

001042 {Each unit ends with: 

001043 »PROC unit# 

001044 JSR % Unit ; Defined bel ow 

001045 JSR unit #x ; for every unit USEd by the unit within $CLASSES+ (in order USEd)... 
001046 ide 

001047 JSR unit #z 

001048 JSR class-init#l ; for every class implemented in unit#i.. 
001049 isath 

001050 JSR class-i nit #k 

001051 RTS 


Apple Lisa ToolKit 3.0 Source Code Listing -- 49 of 1012 


Apple Lisa Computer Technical Information 


001052 

001053 PROCEDURE % Unit; 

001054 

001055 VAR unit PC: LONGI NT; 

001056 hashUNI ndex: INTEGER 

001057 

001058 FUNCTION CompareUnit(hashIndex: | NTEGER): THashCompare 

001059 VAR pc: LONGI NT; 

001060 BEGIN 

001061 pe := pHashUnit *[ hashl ndex] 

001062 IF pe = 0 THEN 

001063 CompareUnit := cHole 

001064 ELSE 

001065 IF pe = unitPC THEN 

001066 CompareUnit := cMatch 

001067 ELSE 

001068 CompareUnit := cMismatch; 

001069 END; 

001070 

001071 BEGIN 

001072 unitPC := Call PC; 

001073 hashUNI ndex := LookupIl nHashArray( maxUnits, unitPC, TRUE, CompareUnit) 
001074 IF hashUNI ndex > 0 THEN {first time here -- let the initialization happen} 
001075 pHashUnit *[hashUNI ndex] := unitPC 

001076 ELSE 

001077 % ExitCaller(0); {exit from .PROC unit#i because we have already initialized this unit} 
001078 END; 

001079 

001080 

001081 {tolnsert, return: -index if class already there or if table full, index (> 0) if a hole found} 
001082 {not tolnsert, return: index (> 0) if class found, -index if not there} 
001083 {return 0 if table is full} 

001084 FUNCTION LookupClassAl pha(keyA8: TA8; tolnsert: BOOLEAN): INTEGER 

001085 

001086 FUNCTION CompareName(hashindex: INTEGER): THashCompare 

001087 VAR myl ndex: INTEGER 

001088 BEGIN 

001089 myl ndex := pHashName*[ hashl ndex] 

001090 1F mylndex = 0 THEN 

001091 CompareName := cHole 

001092 ELSE 

001093 IF pClasses*[myl ndex].classAl pha = keyA8 THEN 

001094 CompareName := cMatch 

001095 ELSE 

001096 CompareName : = cMismatch; 

001097 END; 

001098 


001099 BEGIN 
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001100 
001101 
001102 
001103 
001104 
001105 
001106 
001107 
001108 
001109 
001110 
001111 
001112 
001113 
001114 
001115 
001116 
001117 
001118 
001119 
001120 
001121 
001122 
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001125 
001126 
001127 
001128 
001129 
001130 
001131 
001132 
001133 
001134 
001135 
001136 
001137 
001138 
001139 
001140 
001141 
001142 
001143 
001144 
001145 
001146 
001147 
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LookupClassAl pha := LookupI nHashArray(maxClasses, ORD( keyA8[ 2] )*ORD( keyA8[ 4] ) +ORD( keyA8[6]), 


tolnsert, CompareName) ; 
END; 


FUNCTION FillArraysFrom( pc: LONGINT; itsLevel Number: INTEGER; superSTP: TPSliceTable; 
itsSTP: TPSliceTable; itsOddMethods: INTEGER): LONGI NT; 
{** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING MAllocate **} 
VAR impLevel Number: INTEGER; 
i mpMet hNumber: INTEGER; 
targetLocation: ProcPtr; 
fini: BOOLEAN; 
impMethodArrayPtr: TPMet hodArray; 
index: INTEGER; 
level: INTEGER; 
numAt That Level: INTEGER; 
superMethodArrayPtr: TPMet hodArray; 
caninherit: BOOLEAN; 
methodNumber: INTEGER; 
BEGIN 
impLevel Number := itsLevel Number; 
impMethNumber := 0; 


REPEAT 
targetLocation := % NextMethod(pc, impLevel Number, impMet hNumber); 
fini := (targetLocation = p% Class) OR (targetLocation = pj mp% Class); 
IF NOT fini THEN 
BEGIN 
impMethodArrayPtr := itsSTP*[impLevel Number]; 
[F impMethodArrayPtr = NIL THEN 
BEGIN 
index := numClasses; 
level := itsLevel Number; {always even} 
{$1 FC fTrcClascal } 
WriteLn('pClasses = ', ORD(pClasses)); 
WriteLn(' Index Level', ' impLevel Number = '', impLevel Number: 3); 
WriteLn(index:3, level:12); 
{$ENDC} 
WHILE level > impLevel Number DO 
BEGIN 
index := pClasses*[index].superlndex; 
level := level - 2; 
{$1FC fTrcClascal } 
WriteLn(index:3, level:12); 
{$ENDC} 
END; 


{$1 FC fTrcClascal } 
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001148 WriteLn('-- In FillArrays, making a new method table --') 

001149 WriteLn('pe = ', pce:12, '  itsLevelNumber = '', itsLevel Number: 3, 

001150 ' superSTP = ', ORD(superSTP):12, ' itsSTP = '', ORD(itsSTP): 12) 
001151 WriteLn(' itsOddMethods = ', itsOddMethods: 3, 

001152 ' jmpMethNumber = ', impMethNumber: 3, 

001153 ' targetLocation = ', ORD(targetLocati on): 12) 

001154 WriteLn(' index =', index:3, 

001155 ' level =', level:3, 

001156 ' word[-2] = ', TPWords(pSTables*[index]) *[-2]:7, 

001157 '  word[-1] = ', TPWords(pSTables*[index]) *[-1]:7) 

001158 {$ENDC} 

001159 

001160 numAtThatLevel := TPWords(pSTabl es*[i ndex] ) *[ ORD( ODD(i mpLevel Number) ) - 2] 
001161 

001162 {$I FC fTrcClascal } 

001163 WriteLn('numAtThatLevel = ', numAtThatLevel: 3) 

001164 {$ENDC} 

001165 

001166 impMethodArrayPtr := TPMethodArray( MAI locate(numAtThatLevel, growMethods) ); 
001167 numMethods := numMethods + numAtThatLevel; 

001168 itsSTP*[impLevel Number] := i mpMethodArrayPtr 

001169 

001170 IF superSTP = NIL THEN 

001171 superMethodArrayPtr := NIL 

001172 ELSE 

001173 superMethodArrayPtr := superSTP*[impLevel Number]; {may be NIL} 

001174 

001175 caninherit := (impLevel Number < itsLevel Number) AND (SuperMethodArrayPtr <> NIL) 
001176 

001177 FOR methodNumber := 1 TO numAtThatLevel DO 

001178 IF caninherit THEN 

001179 impMethodArrayPtr“[ methodNumber] := superMethodArrayPtr *[ met hodNumber |] 
001180 ELSE 

001181 impMethodArrayPtr“[ methodNumber] := ORD(@ Abstract); 

001182 END; 

001183 impMethodArrayPtr“[impMethNumber] := ORD(targetLocati on) 

001184 END; 

001185 UNTIL fini; 

001186 

001187 {For any inherited slice that had no overrides, make it point at the same slice as the superclass} 
001188 FOR level := 0 TO itsLevel Number - 1 DO 

001189 IF itsSTP*[level] = NIL THEN 

001190 itsSTP*[level] := superSTP*[level]; {may be NIL, too} 

001191 

001192 {If the odd slice has only ABSTRACT methods, then use a global to tell % Pgm2 what to do} 
001193 IF itsSTP*[itsLevel Number + 1] = NIL THEN 

001194 IF itsOddMethods > biggestAbstractClass THEN 

001195 biggestAbstractClass := itsQddMethods 
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001200 
001201 
001202 
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{$1 FC fTrcClascal } 


DumpArrays; {RRR RRR EERE ERR RR ERR RRR R RRR RAR RRR AAR R RRA RRR ARKH RAH R REAR REE RRR KH) 


{$ENDC} 


Fill ArraysFrom := pc 
END; 


{The class-init routine of TFoo = SUBCLASS OF TSuperclass starts with: 
JSR % Class('TFOO ', 'TSUPERCL', @sliceTable, sizeOfEvenSlice, sizeOfOddSlice, objSize); Defined below 
JSR method#1(sliceNumber*256 + met hodNumber ) ; for every method in the | MPLEMENTATI ON 
tek ; these calls are not executed: % Class interprets them 
JSR method#r(sliceNumber*256 + met hodNumber ) ; slice 0 is TObject, method 1 is first method 
JSR % Class ; Just a terminator (The first call on % Class interprets through here) } 


PROCEDURE % Class(itsClassName, itsSuperName: TS8; itsSTP: TPSliceTable; 
itsEvenMethods, itsOddMethods, itsQObjSize: INTEGER); 
{** NO VAR PARAMETERS ALLOWED THAT ARE REFERENCED AFTER CALLING RAllocate & FillArraysFrom **} 


VAR i: INTEGER; 
itsAl pha: TA8; 
superAl pha: TA8; 
nameHashl ndex: INTEGER 
superCl Index: INTEGER 
super STP: TPSliceTable; 
itsLevel Number: INTEGER 
pc: LONGI NT; 
level: INTEGER; 

BEGIN 


{First class of a unit?} 
IF Call Call PC <> currCall Call PC THEN 
BEGIN 
EndPreviousUnit; 
currCall Call PC := Call Call PC 
END; 


{Increment numClasses but first be sure there is roomin the arrays... this could move ALL the arrays!} 
IF numClasses > (limClasses - 2) THEN 
BEGIN 
i {dummy} := RAllocate(SIZEOF(TClassinfo), numClasses, 
growClasses, limClasses, maxClasses, ‘'Classes', ORD(pClasses)); 
limClasses := RAllocate(SIZEOF(TPSliceTable), numClasses 
growClasses, limClasses, maxClasses, ‘Classes', ORD( pSTables)) 
END; 
numClasses := numClasses + 1; 


{Convert names from TS8 to TA8 type} 
FOR i := 1 TO 8 DO 
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001244 BEGIN 

001245 itsAl phafi] := itsClassName[i]; 

001246 superAl phafi] := itsSuperName[i]; 

001247 END; 

001248 

001249 {Enter this class into the name hash table} 

001250 nameHashl ndex := LookupClassAl pha(itsAl pha, TRUE); {Temporary variable needed because stack may quake} 
001251 IF nameHashindex > 0 THEN 

001252 pHashName*[nameHashl ndex] := numClasses 

001253 ELSE 

001254 {$1 FC fDbgClascal } 

001255 1F nameHashindex < 0 THEN 

001256 CLABreak('Class name appeared twice', numClasses) 

001257 ELSE 

001258 CLABreak('Class Name Hash table full', maxClasses) 

001259 {$ELSEC} 

001260 CLAFail (0); 

001261 {$ENDC} 

001262 

001263 {Hash the name of the superclass} 

001264 IF itsSuperName = 'NIL ' THEN 

001265 BEGIN {This class has no superclass (e.g., TObject)} 
001266 superCll ndex := 0 

001267 itsLevel Number := 0; 

001268 superSTP := NIL; 

001269 END 

001270 ELSE 

001271 BEGIN 

001272 superCll ndex := pHashName*[LookupCl assAl pha(superAl pha, FALSE) ] 
001273 itsLevel Number := NumSlices(superCl Index) 

001274 superSTP := pSTables*[superCll ndex] 

001275 END; 

001276 

001277 {Fill this slice table with NILs for the moment} 

001278 FOR level := 0 TO itsLevel Number + 1 DO 

001279 itsSTP*[level] := NIL; 

001280 

001281 {To be referenced from FillArraysFromto calculate numAt That Level } 
001282 TPWords(itsSTP) *[-2] := itsEvenMethods 

001283 TPWords(itsSTP) *[-1] := itsOddMethods 

001284 

001285 {Initialize the fields of the class record} 

001286 WTH pClasses*[numClasses] DO 

001287 BEGIN 

001288 classAl pha := itsAl pha; 

001289 superlndex := superCllndex 

001290 objectSize := itsObj Size; {may be changed by a call on ClassSize fromthe class-init block} 
001291 classAlias := 0; {may be supplied by a call on ClassAuthor fromthe class-init block} 
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001292 companyAndAuthor := 0; {may be supplied by a call on ClassAuthor or Unit Author} 

001293 version := 1; {may be changed by a call on ClassVersion fromthe class-init block} 
001294 oldestReadableVersion := 1; {may be changed by a call on ClassVersion fromthe class-init block} 
001295 END; 

001296 

001297 {Record the slice table pointer} 

001298 pSTables*[numCl asses] := itsSTP 

001299 

001300 {Before running the user's class-init code, be sure there is space for himto add an Alias and two Authors} 
001301 IF numAuthors > (limAuthors - 2) THEN 

001302 limAuthors := RAllocate(S!ZEOF(TA32), numAuthors 

001303 growAuthors, l|imAuthors, maxAuthors, 'Authors', ORD( pAuthors)) 

001304 

001305 IF numAliases > (limAliases - 1) THEN 

001306 limAliases := RAllocate(SIZEOF(TA8), numAliases 

001307 growAliases, limAliases, maxAliases, ‘Aliases', ORD(pAliases)) 

001308 

001309 {$1 FC fTrcClascal } 

001310 WriteLn(' End of %Class!, stp = ', ORD(itsSTP):5); 

001311 {$ENDC} 

001312 

001313 {[I nterpret and] skip the MOVE/JSR pairs after the call of this procedure} 

001314 SetCall PC(FillArraysFrom(Call PC, itsLevel Number, superSTP, itsSTP, itsOddMethods)); 

001315 END; 

001316 

001317 

001318 END. 

001319 


End of File -- Lines: 1319 Characters: 44959 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 
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{UNIT UABC} 
{Copyright 1983, 1984, Apple Computer, Inc. } 


{ *** METHODS NEED TO BE GROUPED INTO RIGHT CATEGORIES *** } 
{ *** ADD reserve IN ALMOST EVERY CLASS ***} 


UABC2. TEXT TProcess-TDocDirectory-TDocManager-TCli pboard-TCommand-TCut CopyCommand- TPast eCommand} 
UABC3. TEXT Tl mage-TView- TPagi natedVi ew- TPageVi ew- TPri nt Manager- THeadi ng-TSel ecti on} 

UABC4. TEXT TWindow- TDi al ogBox- TMenuBar- TFont } 

UABC5. TEXT TPanel-TBand-TPane-TMargi nPad-TBodyPad-TScroller-TScroll Bar} 


aA Aas 


UNIT UABC: 
{$SETC Islntrinsic := TRUE } 


{$1 FC Islntrinsic} 


INTRINSIC; 
{$ENDC} 
INTERFACE 
USES 
{$U Unit Std } UnitStd, {Client should not USE UnitStd} 
{$U UnitHz } UnitHz, {Client should not USE UnitHz and MUST NOT USE Storage} 
{$U libtk/ UObj ect } UObj ect, {Client must USE UObj ect} 
{$U - #BOOT-SysCall} SysCall, {Client may USE SysCall} 


{$1FC LibraryVersion > 20} 
{$U LIBTK/ Passwd} Passwd, 


{$ENDC} 
{$1FC LibraryVersion <= 20} 

{$U Font Mgr } Font Mgr, {Client should USE UFont instead of FontMgr before QuickDraw} 
{$ENDC} 

{$U QuickDraw  } QuickDraw, {Client must USE QuickDraw (unless we provide a type-stub for it)} 
{$1FC LibraryVersion > 20} 

{$U Font Mgr } Font Mgr, {Client should USE UFont instead of FontMgr after QuickDraw} 
{$ENDC} 

{$U li btk/ UDraw } UDraw, {Client must USE UDraw} 

{Client need not USE anything below this line} 

{$U PMDecl } PMDecl, 

{$1FC libraryVersion <= 20} { PEPSI } 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 
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Information 


{SPRI 


{$U PrStd } PrStd 
{$ENDC} 

{$U WM. Events } Events, 

{$U WM. Folders } Folders 

{$U WM. Menus } Menus 

{$U Alert Mgr } Alert Mgr 
{$1FC LibraryVersion <= 20} 

{$U PrProcs } PrProcs 
{$ENDC} 

{$U WMLstd } WMLstd 

{$U WMLCrs } WMLCrs, 

{$U WMLSb } WMLSb 

{$U WMLGrow } WMLGrow 

{$U Scrap } Scrap 
{$1FC libraryVersion <= 20} 

{$U PrMgr Util } PrMgrUtil, 

{$U PrMgr } PrMgr, 
{$ELSEC} 

{$U PrStdi nfo} PrStdinfo, 

{$U PrPublic} PrPublic, 
{$ENDC} 

{$U FilerComm  } FilerComm; 
{$SETC fDbgABC = fDbgOK}{FALSE} 
{$SETC fRngABC = fDbgOK}{FALSE} 
{$SETC fSymABC = fSymOK}{FALSE} 


{$SETC f DebugMethods 


CONST 


ma x Menus 

max Fonts 
maxSegments 
maxSegSize 
abort ChunkSize 


iconNameSeparator 


stdHHysteresis 
stdVHysteresis 


noCursor 
hiddenCursor 
arrowCursor 
crossCursor 
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31; {unfortunate, 
11; 


6 
$20000; {128K} 
32768; {32k} 


NG } 


:= fDbgABC} {if VAR also true, trace entries and/or exits} 


but menus must be in non-relocatable storage, & this is easiest} 


= '<'; {character separating parts of an icon name} 


9: {amount the mouse must move from anchor before drag starts, unless} 
6; { TSelection. GetHysteresis is overridden} 
-2; { used when you do not set the cursor} 
-1; {icrsHidden Hides the cursor entirely} 

1; {icrslnactive Standard arrow cursor} 

9; {icrsLCCross LisaCalc cross} 
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000092 text Cursor = 10; {icrsXl Beam Standard text |-Beam} 
000093 checkCursor = 12; {icrsCheck Checkmar k} 

000094 smCrossCursor = 13; {icrsGECross LisaDraw cross (smaller than crossCursor) } 
000095 fingerCursor = 14; {icrsLFinger LisaDraw left-pointing finger} 
000096 

000097 firstUserCursor = 100; { this is the smallest user-defined cursor } 
000098 

000099 not hi ngKi nd = 0; 

000100 

000101 noCmdNumber = 0; 

000102 

000103 docLdsn = 3: {Idsn for the first document data segment } 
000104 docDsBytes = 5120; {default heap size for a document data segment} 
000105 docExcess = 2048; {the virtual data segment may be this much larger than needed for the heap} 
000106 

000107 printLdsn = 2! {I dsn to hand to LisaPri nt} 

000108 ascArwDown = $lF; 

000109 ascArwLeft = $1C; 

000110 ascArwRi ght = $1D; 

000111 ascArwUp = $1E; 

000112 ascBackspace = $08; 

000113 ascClear = $1B; 

000114 ascEnter = $03; 

000115 ascReturn = $0D; 

000116 ascTab = $09; 

000117 

000118 {alert phrase codes must be between 9 and 899} 

000119 

000120 phWordDelimiters= 9; 

000121 

000122 phTrouble = 10; {The tool is having trouble} 

000123 phUnknown = 11: {Phrase(error) is undefined for this error} 
000124 phNoText = 21; 

000125 phNoSel = 22; 

000126 phNol nsPt = 23; 

000127 phRevert = 24; 

000128 phRevBl ank = 25; 

000129 phUnkCmd = 26; 

000130 phSel Cant = 27; 

000131 phUnchanged = 28; 

000132 phSavi ng = 29; 

000133 phTer mi nated = 30; 

000134 phEeditClip = 31; 

000135 phNoClip = 32; 

000136 phUnkClip = 33; 

000137 phDi al ogUp = 34; 

000138 phCant Undo = 35; 

000139 phNoCommand = 36; 
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000140 
000141 
000142 
000143 
000144 
000145 
000146 
000147 
000148 
000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
000158 
000159 
000160 
000161 
000162 
000163 
000164 
000165 
000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 
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phOlderVersion = 37; 
phNewerVersion = 38; 
phConverting = 39; 
phAborting = 40; 
phPage = 41; {+SW+} 
phTitle = 42; {+SW+} 
phCant Save = 43; 
phCant Revert = 44; 
phCountry = 45; 


uCreateLayoutBox = 701; {Command numbers} 
uMoveLayoutBoxes = 702; 
uCmdLaunchHeading = 703; 


uCmdI nstall Margins = 704; 


layPickKind = 119; 
layEditLegendKind = 133; 
frameKind = 161; 


{Selection kinds} 


phTooManyChars = 101; {Phrases} 
phOddEven = 102; 
phOddOnly = 103; 


phEvenOnly = 104; 
phOddOrEven = 105; 
phMinPage = 106; 
phMaxPage = 107; 
phPageAlignment = 108; 
phAlignment = 109; 
phTopLeft = 110; 
phTopCenter = 111; 
phTopRight = 112; 
phBotLeft = 113; 
phBotCenter = 114; 
phBot Right = 115; 
phLaunchHeading = 116; 
phPageMargins = 117; 
phUnits = 118; 
phinches = 119; 
phCentimeters = 120; 
phLeft = 121; 
phLeftCluster = 122; 
phTop = 123; 
phTopCluster = 124; 


{command, selection, and phrase indices used by Dialog Building BI ock} 
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000188 
000189 
000190 
000191 
000192 
000193 
000194 
000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
000210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
000228 
000229 
000230 
000231 
000232 
000233 
000234 
000235 


phRight = 125; 
phRightCluster = 126; 
phBottom = 127; 
phBotCluster = 128; 
phinstall Margins = 129; 
phinchTitle= 130; 
phCmTitle = 131; 
phNewHeading = 132; 


phOK = 142; 

phCancel = 143; {deter 
stdBoxWdth = 17; {di 
stdBoxHei ght = 11; 
stdBoxSpacing = 20; 


stdCurvH = 18; 
stdCurvV = 14; 
stdBtnHei ght = 22; 


nol DNumber = -2; 
nold ='': 


IDLength = 9; 


stdTitleHeight = 10; 
stdSli mit! eHei ght 
stdLeftRi ght Border 
stdBottomBorder = 2; 


3 


{errcodes of other librar 


erAborted = 4033; 
erDuplicateName = 890; 
erl nvalidName = 971; 
erNameNotFound = 972: 


{Tool Kit errCodes 


er Password = 4201; 
erVersion = 4202; 
erBadData = 4203; 
er Cant Read = 4304; 
erCant Write = 4305; 
erDirtyDoc = 4306; 
erNoMoreDocs = 4307; 
er NoMemor y = 4308; 
erNoDiskSpace = 4309; 
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Information 


{+SW+} 


mining text and locations of OK/ Cancel 


mensions for default checkboxes} 


{for Buttons} 


{the significant length of id strings} 


{for layout boxes} 


ies} 


{user typed Apple-.; Desktop Manager} 
{0S & Desktop Manager} 
{0S & Desktop Manager} 
{0S & Desktop Manager} 


must be between 4201 and 4499} 


{client should NOT lightly change the phrases for these, since they are used for} 


buttons for built-in ToolKit dialogs} 
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000236 
000237 
000238 
000239 
000240 
000241 
000242 
000243 
000244 
000245 
000246 
000247 
000248 
000249 
000250 
000251 
000252 
000253 
000254 
000255 
000256 
000257 
000258 
000259 
000260 
000261 
000262 
000263 
000264 
000265 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 


er WrongPassword 


er MaxTool Kit 
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4310; 
4499: 


{command codes must be between 101 and 999} 


uSetAll Aside 
uSet Aside 
uPut Away 

uPr Fmt 
uPrintAsls 
uPrint 

uPr Monitor 
uSaveVersi on 


uRevertVersion 


ut Set Aside 
uSetClipAside 


{Typing Buzzword} 


uTyping 


101; 
102; 
103; 
104; 
111; 
105; 
106; 
107; 
108; 
109; {Set Aside “Document *} 
110; 


150; 


{The toolkit uses the following only as arguments to selection. Cant DoCmd} 


uBackspace 


ut UndoLast 
ut RedoLast 


206; {Undo “Last Change*} 
207; {Redo “Last Change*} 


uEnter = 152; 

uForwardSpace = 153; 

uReturn = 154 

uTab = 155: 

{The toolkit uses the following only as arguments to process. Remember Command} 
uSome Command = 156 

uScrolling = 157; 

uSplitting = 158; 

uResizeWindow = 159 

uResi zePanel = 160; 

UMousePress = 161; 

uThumbi ng = 162; 

uMoveWi ndow = 163; 

uKey Down = 164; {could be made the same as uTyping} 
uCopy = 201; 

uCut = 202; 

uPaste = 203; 

uSel Al | = 204; 

uUndoLast = 205; 


uCl ear 


208; 


{$1FC LibraryVersion <= 20} 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
000295 
000296 
000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 


uFnt0 = 300; 
uFntl = 301; 
uF nt 2 = 302; 
uF nt 3 = 303; 
uFnt4 = 304; 
uFnt5 = 305; 
uFnt6 = 306; 
uFnt7 = 307; 
uFnt8 = 308; 
uFnt9 = 309; 
uFnt10 = 310; 
uFnt11 = 311; 
{$ENDC} 
uModern = 320 + 
uClassic = 320 + 
u20Pitch = 330 + 
ul5Pitch = 330 + 
ul2Pitch = 330 + 
ul0Pitch = 330 + 
ul2Poi nt = 330 + 
ul4Poi nt = 330 + 
ul8Poi nt = 330 + 
u24Poi nt = 330 + 
uPl ain = 351; 
uBol d = 352; 
ultalic = 353; 
uUnderline = 354; 
uShadow = 355; 
uOutline = 356; 
uSuperscri pt = 357; 
uSubscri pt = 358; 
uPrvwMar gi ns = 401; 
uPrvwBreaks = 402; 
uPrvwoOf f = 403; 
uDesi gnPages = 405; 
uShowFul | Size = 406 
uReduce70Pct = 407; 
uReduceToFit = 408; 
uSet HorzBreak = 411; 
uSet Vert Break = 412; 
uCl ear Breaks = 413; 
uRiseVertically = 421: 
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famModern - 


famClassic - 


size20Pitch - 
sizel5Pitch - 
sizel2Pitch - 
sizelOPitch - 
sizel2Point - 
sizel4Point - 
sizel8Point - 
size24Point - 


f amMi n; 
f amMi n: 


sizeMin; 
sizeMin; 
sizeMin; 
sizeMin; 
sizeMin; 
sizeMin; 
sizeMin; 
sizeMin; 


{should result in 320} 


{should result in 330} 
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000332 uRiseHorizontally = 422; 

000333 

000334 uAddColumnStrip = 431: 

000335 uAddRowStri p = 432; 

000336 

000337 uReportEvents = 501; 

000338 

000339 uCount Heap = 506; 

000340 

000341 uCheckIndices = 509; 

000342 uDumpGl obals = 510; 

000343 uDumpPrel ude = 511; 

000344 uExperimenting = 512; 

000345 uRept Garbage = 513; 

000346 uFreeGarbage = 514; 

000347 

000348 uMainScramble = 515; 

000349 uDocScrambl e = 516 

000350 

000351 uEditDialog = 521; 

000352 uStopEditDialog = 522; 

000353 

000354 { the standard WantMenu will return FALSE for any menus with menulD >= mBuzzword 
000355 buzzword menus should be assigned IDs >= 100 

000356 debug menus should be assigned IDs 90-99 } 

000357 

000358 {$l FC fDbgABC} 

000359 mBuzzword = 100; 

000360 {$ELSEC} 

000361 mBuzzword = 90; 

000362 {$ENDC} 

000363 

000364 mouClipFilePrint = 1000; {special menulD for Clipboard File/ Print} 
000365 

000366 firstPrivateEvent = 100; {first event type that you can use in TProcess. SendEvent } 
000367 

000368 {$1 FC NOT f DbgABC} 

000369 fExperimenting = FALSE; { not experimenting if debug code if off } 
000370 {$ENDC} 

000371 

000372 TYPE 

000373 

000374 TPrinterMetrics = RECORD 

000375 paperRect: Rect; {the physical rectangle} 
000376 printRect: Rect; {the printable rectangle} 
000377 res: Poi nt; {resolution, spots/inch} 
000378 reserve: ARRAY[0..7] OF BYTE; 

000379 END; 
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000380 

000381 TPreviewMode = (mPrvwMargins, mPrvwBreaks, mPrvw0ff) 

000382 

000383 TDi Response = (diAccept, diDismissDialogBox, diGiveToMainWindow, di Refuse) 

000384 

000385 TEnumAbilities = (aBar, aScroll, aSplit); 

000386 TAbilities = SET OF TEnumAbilities; {for TPanel. Divide/ CREATE argument } 
000387 

000388 TUnitsFromEdge = (pixelsFromEdge, percentFromEdge); {for TPanel. Divide argument} 

000389 

000390 TAlertArg = 1..5; 

000391 TAlertCounter = 7,.9; 

000392 

000393 TAlignment = (aLeft, aRight, aCenter, aJjustify) 

000394 TPageAlignment = (aTopLeft, aTopCenter, aTopRight, aBottomLeft, aBottomCenter, aBottomRi ght); 
000395 

000396 TClickState = RECORD 

000397 where: Point; 

000398 when: LONGI NT; 

000399 clickCount: INTEGER 

000400 fShift, fOption, fApple: BOOLEAN 

000401 END; 

000402 

000403 TCmdNumber = | NTEGER; {the unique identifier of a command in a menu (or elsewhere) } 
000404 

000405 TCmdPhase = (doPhase, undoPhase, redoPhase);{doPhase first time, then undoPhase & redoPhase alternatel y} 
000406 

000407 TCursorNumber = INTEGER 

000408 

000409 TEnumicons = (iSkewer, iScroll Back, iFlipBack, iGrayA, iThumb, iGrayB, iFlipFwd, iScroll Fwd); {Tl con} 
000410 

000411 TMousePhase = (mPress, mMove, mRel ease) 

000412 

000413 TRevelation = (revealNone, revealSome, reveal All); 

000414 

000415 TPrReserve = ARRAY [0..127] OF Byte; {l engt hened} 

000416 TPrelude = 

000417 RECORD 

000418 password: {2} INTEGER 

000419 version: {2} INTEGER: {*** Should also do ABC version protecti on***} 
000420 country: {2} INTEGER 

000421 language: {2} INTEGER 

000422 preludeSi ze: {2} INTEGER: {SI ZEOF(TPrelude), which precedes the heap} 
000423 unused: {6} ARRAY [0..5] OF Byte 

000424 {The above fields should occupy 16 bytes to meet the Lisa standard} 

000425 printPref: {128} TPrReserve 

000426 docSize: {4} LONGI NT; {sum of the sizes of the consecutive data segments} 
000427 numSegments: {2} INTEGER; {no. of segments; all but the last are maxSegSize bytes} 
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000428 docDirectory: {4} TDocDirectory; {whence one finds the class table and the window} 
000429 {Other fields may be added | ater} 

000430 END; 

000431 

000432 TPPrelude = “TPrelude 

000433 

000434 TSBox!D = LONGINT; {THSb alias} 

000435 

000436 TWindowl D = LONGI NT; {WindowPtr alias} 

000437 

000438 TWmgrCmd = 

000439 RECORD 

000440 cmdNumber: INTEGER: {the command number} 

000441 menulndex: Byte; {the ordinal number of the menu in its menu bar (or file) } 
000442 itemlndex: Byte; {the ordinal number of the itemin its menu} 
000443 END; 

000444 

000445 

000446 TProcess = SUBCLASS OF TObject {only one instance exists (process) } 

000447 

000448 {Variables} 

000449 

000450 {Creation/ Destruction} 

000451 FUNCTION {TProcess. }CREATE( object: TObject; heap: THeap): TProcess; 

000452 

000453 {Debugging} 

000454 {$1 FC fDebugMet hods} 

000455 PROCEDURE {TProcess. }Dont Debug; {Turn off all debug flags when last document is closed} 
000456 {$ENDC} 

000457 {$1 FC fDbgABC} 

000458 PROCEDURE {TProcess. }DumpGl obals; {Print most global variables on alternate screen} 
000459 {$ENDC} 

000460 

000461 

000462 {Cursor Tracking} 

000463 PROCEDURE {TProcess. }ChangeCursor(cursorNumber: TCursorNumber) 

000464 { applications call ChangeCursor if they want to change the cursor shape } 
000465 PROCEDURE {TProcess. }DoCursorChange(cursorNumber: TCursorNumber) 

000466 { applications implement DoCursorChange to test cursorNumber for one of their 
000467 cursor shapes; if found, it calls QuickDraw's SetCursor routine, otherwise 
000468 it calls the generic TProcess. DoCursorChange } 

000469 PROCEDURE {TProcess. }TrackCursor; 

000470 

000471 {Error Reporting} 

000472 PROCEDURE {TProcess. }ArgAlert(whichArg: TAlertArg; argText: $255); {whichArg = 1 to 5} 
000473 FUNCTION {TProcess. }Ask(phraseNumber: INTEGER): INTEGER 

000474 PROCEDURE {TProcess. }Begi nWait(phraseNumber: INTEGER) 

000475 FUNCTION {TProcess. }Caution(phraseNumber: INTEGER): BOOLEAN 
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000476 PROCEDURE {TProcess. }CountAlert(whichCtr: TAlertCounter; counter: INTEGER) 

000477 PROCEDURE {TProcess. }DrawAlert(phraseNumber: INTEGER; marginLRect: LRect); 

000478 PROCEDURE {TProcess. }EndWait; 

000479 PROCEDURE {TProcess. }GetAlert(phraseNumber: INTEGER; VAR theText: $255) 

000480 PROCEDURE {TProcess. }Note(phraseNumber: | NTEGER) 

000481 PROCEDURE {TProcess. }RememberCommand(cmdNumber: TCmdNumber); { for *C and *K in alerts } 
000482 FUNCTION {TProcess.}Phrase(error: INTEGER): INTEGER 

000483 PROCEDURE {TProcess. }Stop(phraseNumber: INTEGER) 

000484 

000485 {I nitiate/Termi nate} 

000486 PROCEDURE {TProcess. }Commence(phraseVersion: INTEGER); {process init after the process object exists} 
000487 PROCEDURE {TProcess. }Complete(alllsWell: BOOLEAN); 

000488 

000489 {Abort Handling} 

000490 FUNCTION {TProcess. }AbortRequest: BOOLEAN 

000491 PROCEDURE {TProcess. }AbortXferSequential(whichWay: xReadWrite; pFirst: Ptr; 

000492 numBytes, chunkSize: LONGINT; fs: TFileScanner); 
000493 

000494 {Main Loop} 

000495 PROCEDURE {TProcess. }ObeyEvents(FUNCTION StopCondition: BOOLEAN) 

000496 {This will return IF: (1) amDying is TRUE (application termi nated) 
000497 or (2) StopCondition returns TRUE (StopCondition is checked 

000498 only when no events are available, before starting to idle.) } 
000499 

000500 PROCEDURE {TProcess. }ObeyFil erEvent; 

000501 PROCEDURE {TProcess. }ObeyTheEvent; 

000502 PROCEDURE {TProcess. }Run; 

000503 

000504 {Private Events (Inter-process communi cation) } 

000505 PROCEDURE {TProcess. }HandlePrivateEvent(typeOfEvent: INTEGER; fromProcess: LONGI NT; 
000506 when: LONGINT; otherData: LONGI NT); DEFAULT; 

000507 PROCEDURE {TProcess. }SendEvent(typeOfEvent: INTEGER; targetProcess: LONGINT; otherData: LONGI NT); 
000508 

000509 {Memory Management } 

000510 PROCEDURE {TProcess. }BindCurrent Document; 

000511 

000512 {Open/Close Wi ndow/ Document } 

000513 FUNCTION {TProcess. }NewDocManager(volumePrefix: TFilePath; openAsTool: BOOLEAN) 
000514 : TDocManager; DEFAULT; 

000515 

000516 {External Document Support} 

000517 PROCEDURE {TProcess. }CopyExternal Doc(VAR error: INTEGER; 

000518 external Name, volumePrefix: TFilePath); DEFAULT 

000519 {This is called if the application puts icons into the clipboard and the user 
000520 then pastes theminto a folder or disk. } 

000521 

000522 END; 

000523 
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000524 
000525 
000526 
000527 
000528 
000529 
000530 
000531 
000532 
000533 
000534 
000535 
000536 
000537 
000538 
000539 
000540 
000541 
000542 
000543 
000544 
000545 
000546 
000547 
000548 
000549 
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000556 
000557 
000558 
000559 
000560 
000561 
000562 
000563 
000564 
000565 
000566 
000567 
000568 
000569 
000570 
000571 


Apple Lisa Computer Technical 


Information 


TDocDirectory = SUBCLASS OF TObj ect 


{Variables} 
wi ndow: TWi ndow; 
classWorld: TCl assWorld 


{Creation/ Destruction} 
{TDocDirectory. }CREATE( object: TObject; heap: THeap; 


FUNCTI ON 


{Version Conversion} 
PROCEDURE {TDocDirectory. }Adopt; 


END; 


itsWndow: TWindow; 


itsClassWorld: TClassWorld): TDocDirectory; 


TDocManager = SUBCLASS OF TObject 


{Variables} 


files: 
RECORD 
vol umePrefix: 
vol ume: 


{$1FC LibraryVersion > 20} 


{$ENDC} 


{Creation/ Destruction} 
{TDocManager. }CREATE( object: TObj ect; 


password: 


saveExists: 
shoul dSuspend: 


shoul dTool Save: 


END; 
dataSegment: 
RECORD 
ref num: 
preludePtr: 
changes: 
END; 
docHeap: 
wi ndow: 
pendi ngNote: 
openedAsTool 


FUNCTI ON 


{Debugging} 


{$1 FC fDbgABC} 


TFilePath; 
TFilePath; 


TPassword; 
BOOLEAN; 


BOOLEAN; 
BOOLEAN; 


ARRAY [1..maxSegments] OF INTEGER 


TPPrel ude; 
LONGI NT; 


THeap; 

TWi ndow; 
| NTEGER; 
BOOLEAN; 


PROCEDURE {TDoc Manager. }DumpPrel ude 
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{Desktop Manager volume and prefix of OS files} 
{Desktop Manager volume of OS files; -volname- } 


{The password for this document} 
{whether Save file is known to exist and seem readabl e} 


{should we create suspend files?} 
{should we create save files if opened as a tool?} 


{refnums of its data segments} 
{a pointer to the prelude of the data segment} 
{How many changes since the last checkpoint} 
{the heap starts after the prelude} 


{the document's window (it is in the data segment) } 
{If <> 0, NOTE alert that was requested while inactive} 


heap: THeap; itsPathPrefix: TFilePath): TDocManager 


{Print most of prelude on alternate screen} 
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000619 


{$ENDC} 


Apple Lisa Computer Technical 


Information 


{Attributes} 


FUNCTI ON 


{TDocManager. 


{Process Termi nati on} 
PROCEDURE {TDocManager. }Complete(alllsWell: BOOLEAN); 


{Open/Close 
FUNCTI ON 


{Files} 


Wi ndow} 


{TDocManager. 


}WindowWithi d(wmgr!D: TWindowl D): TWindow 


}NewWi ndow( heap: THeap; wmgrlD: TWindowlD): TWindow; DEFAULT; 


PROCEDURE {TDocManager. }Close(afterSuspend: BOOLEAN); 
{ CloseFiles is for the application to override if it has any of its own files that must he 
closed } 


PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


PROCEDURE 


{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 


{TDocManager. 


{Data Segment} 


PROCEDURE 
PROCEDURE 
PROCEDURE 


PROCEDURE 
FUNCTI ON 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
END; 


{TDocManager. 
{TDocManager. 
{TDocManager. 


{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 
{TDocManager. 


}CloseFiles; 
}Open( VAR error: INTEGER; wmgr!lD: TWindowlD; VAR OpenedSuspended: Bool ean); 
}OpenBl ank(VAR error: INTEGER; wmgrlD: TWi ndowl D) 
}OpenSaved(VAR error: INTEGER; wmgrlD: TWi ndowl D) 
}OpenSuspended(VAR error: INTEGER; wmgrlD: TWi ndowl D) 
}RevertVersion(VAR error: INTEGER; wmgrlD: TWi ndowl D) 
}SaveVersion( VAR error: INTEGER; volumePrefix: TFilePath; 
andContinue: BOOLEAN) 
}Suspend(VAR error: INTEGER) 


}Assi mil ate( VAR error: INTEGER) 
}Bind; DEFAULT; 
}ConserveMemory( maxExcess: LONGINT; fGC: BOOLEAN) 

{if fGC is TRUE also do a garbage collect -- on debugging versions 
we just report garbage, on non-debugging versions we free it 
also. } 

}Deactivate; 

}DfltHeapSize: LONGI NT; 

}ExpandMemory(bytesNeeded: LONGI NT); 

}Kil | Segments(first, last: INTEGER) 

}MakeSegments(VAR error: INTEGER; oldSegments: INTEGER; newDocSize: LONGINT); 
}ResumeAfterOpen( VAR error: INTEGER; wmgrlD: TWindowl D); 

}SetSegSize(VAR error: INTEGER; minSize, maxExcess: LONGI NT); 

}Unbi nd; DEFAULT; 


TClipboard = SUBCLASS OF TDocManager 


{Variables} 
has Vi ew: BOOLEAN; {FALSE if no tool-kit-specific representation available} 
hasPicture: BOOLEAN; {FALSE if no universal picture avail able} 
hasUni versal Text: BOOLEAN; {FALSE if no universal text available} 
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000620 
000621 
000622 
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000664 
000665 
000666 
000667 


Apple Lisa Computer Technical 


Information 


hasl con: 


BOOLEAN; 


{TRUE if there is an icon reference available} 


{****NOTE: The only way into or out of Universal Text is via the Universal Text Building Bl ock****} 


cuttingTool: 
cuttingProcesslD 
clipCopy: 


{Creation/ Destruction} 
FUNCTI ON 


{Editing} 


PROCEDURE {TClipboard. 
PROCEDURE {TClipboard. 
PROCEDURE {TCli pboard. 


{Undo} 


PROCEDURE {TCli pboard. 
{TClipboard. 


FUNCTI ON 


{Identification} 


PROCEDURE {TCli pboard. 
PROCEDURE {TCli pboard. 


{Data Segment} 
{PROCEDURE 
{PROCEDURE 


END; 


LONGI NT; 
LONGI NT; 
TFil eScanner; 


{TClipboard. 


TCli pboard. 
TCli pboard. 


{The tool number of the tool that loaded the Clipboard, or 0} 

{The OS process ID of the tool that loaded the Clipboard, or 0} 

{IF <> NIL a scanner on the file containing a copy of the 
clipboard before conversion. } 


}CREATE( object: TObject; heap: THeap): TClipboard 


}About ToCut; 
}Begi nCut; 
}EndCut; 


{whether or not data will actually be put in the data seg} 


}Commi t Cut; 


}UndoCut: BOOLEAN; {return TRUE if succeeds} 


}I nspect; 
}Publicize; 


Bi nd: } 
Unbi nd; } 


TCommand = SUBCLASS OF TObj ect 


{Variables} 
cmdNumber: TCmdNumber; {the command number of the menu itemthat describes the command 
usually the same one the user chose, but not necessarily} 
i mage: Tl mage; {lf non-NIL, affects filtering by image. EachVirtual Part} 
undoable: BOOLEAN; {TRUE iff this command is undoabl e} 
doing: BOOLEAN; {TRUE if Performing or just did doPhase or redoPhase} 
revelation: TRevel ati on; {reveal None/Some/All of selection before performing command} 


unHiliteBefore: ARRAY [TCmdPhase] OF BOOLEAN; {TRUE -> Toolkit unhilites all selections before 


hiliteAfter: 


{Creation/ Destruction} 
FUNCTI ON 


{Filtering} 
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perform} 


ARRAY [TCmdPhase] OF BOOLEAN; {TRUE -> Toolkit hilites all selections after perform} 


{TCommand. }CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itslmage: Tlmage; isUndoable: BOOLEAN; itsRevelation: TRevelation): TCommand 
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PROCEDURE {TCommand. }EachVirtual Part( PROCEDURE DoToObject(filteredObj: TObject)); 
PROCEDURE {TCommand. }FilterAndDo( actual Obj: TObject; PROCEDURE DoToObject(filteredObj: TObject)); 


{Command Execution} 
PROCEDURE {TCommand. }Commit; DEFAULT; {commit a command} 
PROCEDURE {TCommand. }Perform(cmdPhase: TCmdPhase); DEFAULT; {do, undo, or redo a command} 


END; 


TCutCopyCommand = SUBCLASS OF TCommand 


{Variables} 
isCut: BOOLEAN; {TRUE iff this was a cut; FALSE iff a copy} 


{Creation/ Destruction} 
FUNCTION {TCutCopyCommand. }CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itsl mage: Tlmage; isCutCmd: BOOLEAN): TCutCopyCommand; 


{Command Execution} 
{PROCEDURE TCutCopyCommand. Commit; } 
PROCEDURE {TCutCopyCommand. }DoCutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN 
cmdPhase: TCmdPhase); DEFAULT 
{the clipboard is already set up; you only have to load data into it in doPhase} 
{PROCEDURE TCutCopyCommand. Perform(cmdPhase: TCmdPhase); } 


END; 


TPasteCommand = SUBCLASS OF TCommand 


{Creation/ Destruction} 
FUNCTION {TPasteCommand. }CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itslmage: Tl mage): TPasteCommand 


{Command Execution} 
PROCEDURE {TPasteCommand. }DoPaste(clipSelection: TSelection; pic: PicHandle; 
cmdPhase: TCmdPhase); DEFAULT; 
{the clipboard is already set up, except in undoPhase sel & pic are NIL} 
{PROCEDURE TPasteCommand. Perform(cmdPhase: TCmdPhase) ; } 


END; 
Tl mage = SUBCLASS OF TObj ect 


{Variables} 
extentLRect: LRect; {the bounding box for updates; also for default hit-testing} 
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000716 vi ew: TView 

000717 allowMouseOutside: BOOLEAN; {lf TRUE, Tlmage. MouseTrack will NOT force the mouse point 
000718 to lie within the extentLRect; Tlmage. CREATE sets this FALSE} 
000719 

000720 {met hods} 

000721 FUNCTION {Tl mage. }}CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsView: TView): Tl mage 
000722 

000723 FUNCTION {TI mage. }CursorAt(mouseLPt: | Point): TCursorNumber; DEFAULT; 

000724 PROCEDURE {Tl mage. }Draw; DEFAULT 

000725 PROCEDURE {TI mage. }EachActual Part (PROCEDURE DoToObject(filteredObj: TObject)); DEFAULT; 

000726 PROCEDURE {Tl mage. }EachVirtual Part( PROCEDURE DoToObject(filteredObj: TObject)); DEFAULT; 

000727 PROCEDURE {TI mage. }FilterAndDo( actual Obj: TObject; PROCEDURE DoToObj ect(filteredObj: TObject)); 
000728 PROCEDURE {TI mage. }HaveView(view: TView); DEFAULT 

000729 FUNCTION {TI mage. }Hit(mouseLPt: | Point): BOOLEAN; DEFAULT; 

000730 PROCEDURE {TI mage. }Invalidate; {does NOT do it on all pads} 

000731 FUNCTION {Tl mage. }}LaunchLayoutBox(view: TView): Tl mage; DEFAULT; 

000732 PROCEDURE {TI mage. }OffSetBy(deltaLPt: LPoint); DEFAULT; 

000733 PROCEDURE {TI mage. }OffSetTo(newTopLeft: LPoint); 

000734 PROCEDURE {TI mage. }MouseMove( mouseLPt: | Point); DEFAULT 

000735 PROCEDURE {TI mage. }MousePress(mouseLPt: | Point); DEFAULT; 

000736 PROCEDURE {TI mage. }MouseRel ease; DEFAULT; 

000737 PROCEDURE {TI mage. }MouseTrack( mPhase: TMousePhase; mouseLPt: LPoint); DEFAULT; 

000738 PROCEDURE {TI mage. }ReactToPrinterChange; DEFAULT; 

000739 PROCEDURE {TI mage. }}RecalcExtent; DEFAULT; 

000740 PROCEDURE {TI mage. }Resize(newExtent: LRect); DEFAULT; 

000741 FUNCTION {TI mage. }SeesSameAs(image: Tl mage): BOOLEAN; DEFAULT; {$} 

000742 

000743 END; 

000744 

000745 

000746 TView = SUBCLASS OF Tl mage 

000747 

000748 {Variables} 

000749 panel: TPanel; {The panel in which it is viewed} 

000750 clickLPt: LPoi nt; {The last place the user clicked the mouse button} 
000751 print Manager: TPrint Manager; {NIL if view not printable} 

000752 res: Point; {resolution, spots/inch} 

000753 

000754 screenPad: TPad; {like noPad, but scales from view coords to screen coords if view 
000755 resolution and screen resolution differ 

000756 *** CAUTION -- Only for mapping coordinates-- DO NOT try to 
000757 Focus this pad or do Invals, etx ***} 

000758 

000759 fitPagesPerfectly: BOOLEAN; {whether view size should fluctuate automatically so that one always 
000760 ends up with an even number of pages} 

000761 

000762 isPrintable: BOOLEAN; {Whether this view can be printed} 

000763 is Mai nVi ew: BOOLEAN; {FALSE if an auxiliary view, such as page view or paginated vi ew} 
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stdScroll: LPoint; 
scroll PastEnd: Point; {Amount we should scroll past the end of the view} 


{Creation/ Destruction} 

FUNCTION {TView. }CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itsExtent: LRect; 
itsPrintManager: TPrintManager; itsDfltMargins: LRect; itsFitPagesPerfectl y: BOOLEAN 
itsRes: Point; isMainView: BOOLEAN): TView 

{PROCEDURE TView. Free; } 


{Attributes} 
PROCEDURE {TView. }Bel nPanel (panel: TPanel); 
PROCEDURE {TView. }GetStdScroll(VAR deltaLStd: LPoint); 
FUNCTION {TView. }MaxPageToPrint: LONGI NT; 


{Pagi nati on} 
PROCEDURE {TView. }AddStri pOf Pages(vhs: VHSelect); DEFAULT; 
FUNCTION {TView. }ForceBreakAt(vhs: VHSelect; precedingLocation: LONGI NT; 
proposedLocation: LONGI NT): LONGI NT; 
PROCEDURE {TView. }}RedoBreaks; DEFAULT; 
PROCEDURE {TView. }RemapManual Breaks( 
FUNCTION NewBreakLocation(vhs: VHSelect; oldBreak: LONGINT): LONGI NT) 


{Cross-Panel Drag} 
FUNCTION {TView. }DoReceive(selection: TSelection; | PtInView: LPoint): BOOLEAN 


{Direct Display Permission -- per panel } 
FUNCTION {TView. }OKToDrawin(|RectinView: LRect): BOOLEAN; {Default is FALSE; app can override} 


{Cursor tracking - per pane} 
{FUNCTION TView. CursorAt(mouseLPt: LPoint): TCursorNumber; } 


{Resizing} 
{PROCEDURE TView. Resize(newExtent: LRect);} 
PROCEDURE {TView. }Set Mi nViewSize(VAR minLRect: LRect); 


{Clipboard Setup} 
PROCEDURE {TView. }CreateUni versal Text; 


{Variables embedded in text} 
PROCEDURE {TView. }SetFunctionValue( keyword: $255; VAR itsValue: $255); 


{Selecting} 
FUNCTION {TView. }NoSelection: TSelection; 
END; 


TPaginatedView = SUBCLASS OF TView 
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000812 

000813 {Variables} 

000814 unpagi nat edVi ew: TVi ew; {the unpaginated view from whence this derives} 
000815 

000816 pageSi ze: ARRAY[VHSelect] OF LONGINT; {width/height of a page's representation on the screen, 
000817 in the same metrics as the regular view -- could still 
000818 differ from actual screen space a/c screen horiz/vertical 
000819 resolution} 

000820 

000821 working! nMar gins: BOOLEAN 

000822 

000823 {Creation/ Destruction} 

000824 FUNCTION {TPaginatedView. }CREATE(object: TObject; heap: THeap 

000825 itsUnpaginatedView: TView): TPaginatedVi ew 

000826 

000827 {PROCEDURE TPaginatedView. AddStripOfPages(vhs: WHSel ect); } 

000828 PROCEDURE {TPagi natedVi ew. }AdornPageOnScreen; 

000829 {FUNCTION  TPaginatedView. CursorAt(mouseLPt: LPoint): TCursorNumber; } 

000830 PROCEDURE {TPaginatedView. }DepagifyLPoint(pagLPt: LPoint; VAR unPagLPt: LPoint); 
000831 PROCEDURE {TPagi natedVi ew. }DoOnPages(focusOnlnterior: BOOLEAN; PROCEDURE DoOnAPage) 
000832 {PROCEDURE TPaginatedView. Draw; } 

000833 {PROCEDURE TPaginatedView. MouseTrack(mPhase: TPhase; mouseLPt: LPoi nt); } 

000834 PROCEDURE {TPaginatedView. }}PagifyLPoint(unPagLPt: LPoint; VAR pagLPt: LPoint) 

000835 {PROCEDURE TPaginatedView. ReactToPrinterChange; } 

000836 {PROCEDURE TPaginatedView. RedoBreaks; } 

000837 

000838 END; 

000839 

000840 

000841 TPageView = SUBCLASS OF TView 

000842 

000843 FUNCTION {TPageView. }CREATE(object: TObject; heap: THeap 

000844 itsPrintManager: TPrintManager): TPageView 

000845 {PROCEDURE TPageView. Draw; } 

000846 END; 

000847 

000848 

000849 THeading = SUBCLASS OF Tl mage {a header/footer image} 

000850 

000851 print Manager: TPrint Manager 

000852 pageAl i gnment: TPageAl i gnment 

000853 of fsetFromAl i gnment: LPoint; 

000854 

000855 oddOnl y: BOOLEAN; {to restrict printing only to odd-numbered pages} 

000856 evenOnl y: BOOLEAN; { ditto even } 

000857 mi nPage: LONGI NT; {minimum page number to want this heading} 

000858 max Page: LONGI NT; {maximum page number to want it} 

000859 
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{Creation/ Destruction} 
FUNCTION {THeading. }CREATE(object: TObject; heap: THeap; itsPrintManager: TPrint Manager 
itsExtentLRect: LRect; itsPageAlignment: TPageAlignment; 
itsOffsetFromAlignment: LPoint): THeading 


{Attributes} 
PROCEDURE {THeading. }ChangePageAl i gnment(newPageAlignment: TPageAlignment); 


{Selective Use} 
FUNCTION {THeading. }ShouldDraw( pageNumber: LONGINT): BOOLEAN; 
FUNCTION {THeading. }ShouldFrame: BOOLEAN; DEFAULT; 


{Display} 
PROCEDURE {THeading. }Adj ustForPage( pageNumber: LONGINT; editing: BOOLEAN); DEFAULT; 
PROCEDURE {THeading. }LocateOnPage(editing: BOOLEAN); 

{PROCEDURE THeading. Draw; } 
END; 


TPrint Manager = SUBCLASS OF TObj ect 


vi ew: TView 
pageVi ew: TVi ew 
breaks: ARRAY[VHSelect] OF TArray; {of LONGI NT} 
{pagebreak representation: absolute value gives location; negative 
signifies manual break; nonnegative signifies automatic pagebreak} 
pageMargins: LRect; {in view resolution; top and left are > 0, bot & right < 0} 
headings: TList; {OF THeading} 
canEdit Pages: BOOLEAN 
| ayout Di al ogBox: TDi al ogBox; 
frameBody: BOOLEAN 
paperLRect: LRect; 
printableLRect: LRect; 
contentLRect: LRect; {the inner rectangle into which chunks of view are stuffed} 
printerMetrics: TPrinterMetrics; {physical properties of the printer} 


pageRiseDirection: VHSelect; 
{if 'h', it means that page numbers rise fromleft to right fastest; 
if 'v', it means that page numbers rise fromtop to bottom fastest; 
default value is 'h'} 


FUNCTION {TPrintManager. }CREATE( object: TObject; heap: THeap): TPrint Manager 
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000953 
000954 
000955 


PROCEDURE 
{PROCEDURE 


PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTI ON 
FUNCTI ON 
FUNCTI ON 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


END; 


Apple Lisa Computer Technical 


Information 


{TPrint Manager. 
TPrint manager. 


{TPrint Manager. 
{TPrintManager. 
{TPrintManager. 
{TPrint Manager. 
{TPrintManager. 
{TPrint Manager. 
{TPrintManager. 
{TPrintManager. 
{TPrint Manager. 
{TPrint Manager. 
{TPrint Manager. 
{TPrint Manager. 
{TPrintManager. 
{TPrintManager. 
{TPrintManager. 
{TPrint Manager. 
{TPrint Manager. 


}Init(itsMainView: TView 
Free; } 


itsDfltMargins: LRect); 


}AddStripOfPages(vhs: VHSelect); 

}ChangeMargins( margins: LRect); 

}ClearPageBreaks( automatic: BOOLEAN); 
}DrawBreaks( manual Only: BOOLEAN); 
}DrawOneBreak(pageBreak: LONGINT; vhs: vhSelect); 
}DrawPage; 

}EnterPageEdi ting; 


}Get PageLi mits( pageNumber: LONGINT; VAR viewLRect: LRect); 
}NewPaginatedView(object: TObject): TPaginatedView 
}NewPageView(object: TObject): TView 

}PageWth( VAR I PtI nView: LPoint; VAR strip: Point): LONGI NT; 
}Print(printPref: TPrReserve); 

}React ToPri nterChange 

}RedoBreaks; 

}SetBreak(vhs: VHSelect; where: LONGINT; isAutomatic: BOOLEAN) 


}Set DfltHeadings; 
}Ski pPage( pageNumber: 


DEFAULT; 
LONGI NT); 


{TPrintManager definition} 


TSelection = SUBCLASS OF TObj ect 


{Variables} 
wi ndow: TWi ndow; {the window in which it was made} 
panel: TPanel; {the panel in which it was made} 
view: TVi ew; {the view or subview of panel in which it was made} 
kind: | NTEGER; {0 means no selection, rest of codes are defined by view} 
anchorLPt: LPoint; {the place the mouse went down (view-rel ative) } 
currLPt: LPoint; {the place the mouse was last tracked} 
boundLRect: LRect; {bounding box of the selection} {+++LSR+++} 
coSelection: TSelection; {if non-NIL, a selection to forward unimplemented methods to} 
canCrossPanels: BOOLEAN; {:=TRUE in MousePress/ FALSE in MouseRelease for cross-panel drag} 
{Creation/ Destruction} 
FUNCTION {TSelection. }CREATE(object: TObject; heap: THeap; itsView: TView; itsKind: INTEGER 
itsAnchorLPt: LPoint): TSelection; 
{FUNCTION  TSelection. Clone(heap: THeap): TObj ect; } {clones coSel ection} 
FUNCTION {TSelection. }FreedAndRepl acedBy(selection: TSelection): TSel ection; 


{Attributes} 


PROCEDURE 
PROCEDURE 


{Files} 


{TSelection. }GetHysteresis(VAR hysterPt 


Point); DEFAULT; {rtns a delta from orig panel pt} 


{TSelection. }}HaveView(view: TView); 
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000958 
000959 
000960 
000961 
000962 
000963 
000964 
000965 
000966 
000967 
000968 
000969 
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000971 
000972 
000973 
000974 
000975 
000976 
000977 
000978 
000979 
000980 
000981 
000982 
000983 
000984 
000985 
000986 
000987 
000988 
000989 
000990 
000991 
000992 
000993 
000994 
000995 
000996 
000997 
000998 
000999 
001000 
001001 
001002 
001003 


PROCEDURE 


Apple Lisa Computer Technical 


Information 


{TSel ection. 


{Command Dispatch} 


FUNCTI ON 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTI ON 
PROCEDURE 


{I dl e} 
PROCEDURE 
PROCEDURE 
PROCEDURE 


{Editing -- 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


{Drawing -- 
PROCEDURE 


{Selecting} 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 


{TSel ection. 
{TSel ection. 
{TSel ection. 


}MarkChanged; DEFAULT; {Increment change counters} 


}CanDoCommand(cmdNumber: TCmdNumber; VAR checkit: 
}Cant DoCmd(cmdNumber: TCmdNumber); DEFAULT; 
}CantDolt; DEFAULT; 

}DoKey(ascii: CHAR; keycap: Byte; shiftKey, appleKey, opti onKey: 
}NewCommand(cmdNumber: TCmdNumber): TCommand; DEFAULT; 
}PerformCommand(command: TCommand; cmdPhase: TCmdPhase); DEFAULT; 


BOOLEAN): BOOLEAN; DEFAULT; 


BOOLEAN); 
dl eBegin(centiSeconds: LONGINT); DEFAULT; 


}l 
}l dleContinue(centiSeconds: LONGINT); DEFAULT 
}l dleEnd(centiSeconds: LONGINT); DEFAULT; 


to be overridden by applications} 


{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 


per pane} 


{TSel ection. 


{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 
{TSel ection. 


{Undo Maintenance} 


PROCEDURE 
PROCEDURE 


{Scroll 
PROCEDURE 


END; 


{TSel ection. 
{TSel ection. 


into view} 
{TSel ection. 
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}KeyBack(f Word: BOOLEAN); DEFAULT 
}KeyChar(ch: CHAR); DEFAULT 
}KeyClear; DEFAULT; 

}KeyEnter(dh, dv: INTEGER); DEFAULT; 
}KeyForward(f Word: BOOLEAN); DEFAULT; 
}KeyPause; DEFAULT; {Pause in typing} 
}KeyReturn; DEFAULT; 
}KeyTab( f Backward: BOOLEAN); 
}Select Paragraphs 


DEFAULT; 


}Hi ghlight(highTransit: THighTransit); DEFAULT; 


}DeSelect; DEFAULT; 
}DrawGhost; DEFAULT; 


}MousePress(mouseLPt: LPoint); DEFAULT; 

}MouseMove( mouseLPt: LPoint); DEFAULT; 

}MouseRelease; DEFAULT 

}MoveBackToAnchor; DEFAULT; {called when cross-panel drag has been refused} 
}Restore; DEFAULT; 

}Save; DEFAULT; 


}Reveal (asMuchAsPossi ble: BOOLEAN); DEFAULT; 


TW ndow = SUBCLASS OF TArea 
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001004 
001005 
001006 
001007 
001008 
001009 
001010 
001011 
001012 
001013 
001014 
001015 
001016 
001017 
001018 
001019 
001020 
001021 
001022 
001023 
001024 
001025 
001026 
001027 
001028 
001029 
001030 
001031 
001032 
001033 
001034 
001035 
001036 
001037 
001038 
001039 
001040 
001041 
001042 
001043 
001044 
001045 
001046 
001047 
001048 
001049 
001050 
001051 


{Variables} 


panels: 

panel Tree: 

di al ogBox: 
select Panel: 
undoSel Panel : 
clickPanel: 


undoClickPanel: 


select Window: 


undoSel Window 
wmgr | D: 
isResizable: 
believeWmgr: 


maxl nnerSi ze: 


changes: 
last Cmd: 


printerMetrics: 


pgSzOK: 
pgRgOK: 
panel ToPrint: 


obj ectToFree: 


FUNCTI ON 


{PROCEDURE 


{$1 FC f DbgABC} 
{Debugging} 


Apple Lisa 


Computer Technical Information 


TList {OF TPanel}; 
TArea; 

TDi al ogBox; 

TPanel 

TPanel 

TPanel 

TPanel 

TWi ndow; 


TWi ndow; 
TWi ndowl D; 


BOOLEAN; 
BOOLEAN; 


Point; 

LONGI NT; 
TCommand: 
TPrinterMetrics; 
BOOLEAN; 
BOOLEAN; 

TPanel 


TObj ect; 


{Creation/ Destruction} 
{TWindow. }CREATE(object: TObject; heap: THeap; itsWmgrlD: TWindowlD; itsResizability 


{The panels in the window (at least one) } 

{no panels: NIL, one panel: that; else a TBranchArea} 

{NIL if SELF 1S a dialog box window} 

{The panel with the active selection} 

{The selectPanel during the last command} 

{The panel in which the user last clicked in a pane} 

{The clickPanel during the last command} 

{The window with the active selection -- 
SELF or its Dialogbox } 

{the selectWindow during the last command} 

{ORD( Pointer to the Window Manager's GrafPort)} 

{Ils there a Resize Box} 

{TRUE iff the Toolkit should believe the window 
manager's idea of the size of the window 
this will be FALSE (for example) if we create 
the window object before the window is put on 
the screen. } 

{The window size the user explicitly set with grow 
icon} 

{How many changes since the last save} 

{last undoable command obj ect} 

{Properties of the printer currently formatted for} 

{Whether to allow user-defined page-sizes in Fmt For 
Printer dialog} 

{Whether page-range dialog should be enabled in PRINT.. 

dialog -- normally TRUE} 

{NB: |F >1 printable panel in window, choice should be 

made by providing separate menu items} 

{used to stash a reference to an object which should be 
freed at end of event | oop} 


either 


BOOLEAN): TWindow 


TWindow. Free; } 


PROCEDURE {TWindow. }ToggleFlag(VAR flag: BOOLEAN); DEFAULT; {Toggle a debug flag in a menu} 


{$ENDC} 


{Attributes} 


{PROCEDURE 


TWindow. Get MinExtent(VAR minExtent: Point; windowlsResizinglt: BOOLEAN); } 


PROCEDURE {TWindow. }GetTitle(VAR title: $255); {Get the window title} 


FUNCTI ON 
FUNCTI ON 


{TWindow. }l sActive: 
{TWindow. }Il sVisible: 


BOOLEAN; 
BOOLEAN; 


PROCEDURE {TWindow. }Set Wmgrild(itsWmgrld: TWindowlD); {Also sets port fields of panes} 
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001052 
001053 
001054 
001055 
001056 
001057 
001058 
001059 
001060 
001061 
001062 
001063 
001064 
001065 
001066 
001067 
001068 
001069 
001070 
001071 
001072 
001073 
001074 
001075 
001076 
001077 
001078 
001079 
001080 
001081 
001082 
001083 
001084 
001085 
001086 
001087 
001088 
001089 
001090 
001091 
001092 
001093 
001094 
001095 
001096 
001097 
001098 
001099 


{But toni ng} 
PROCEDURE 
{FUNCTION 


{Dialog Box 
PROCEDURE 
PROCEDURE 


{Display} 
{PROCEDURE 
{PROCEDURE 

PROCEDURE 
{PROCEDURE 
PROCEDURE 


{Resizing} 
PROCEDURE 
PROCEDURE 
PROCEDURE 
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{TWindow. }DownEventAt(mousePt: Point); DEFAULT; 
TWindow. DownAt(mousePt: Point): BOOLEAN; } 


affairs} 
{TWi ndow. }Put UpDi al ogBox(dialogBox: TDialogBox); DEFAULT; 
{TWi ndow. }TakeDownDi alogBox; DEFAULT; 


TWindow. Focus; } 

TWindow. Frame; } 

{TWindow. }Hi ghlight(highTransit: THighTransit); DEFAULT; 

TWindow. Refresh(rActions: TActions; highTransit: THighTransit); } 
{TWindow. }Update(doHilite: BOOLEAN); DEFAULT; 


{TWi ndow. }Downl nSizeBox(mousePt: Point); DEFAULT; 
{TWindow. }Resize( moving: BOOLEAN); DEFAULT; {Reset size from portRect size (w. adjustments) } 
{TWindow. }ResizeTo(newSize: Point); DEFAULT; {callable from application} 


{Command Dispatch and Menus} 


FUNCTI ON 
FUNCTI ON 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTI ON 
FUNCTI ON 
PROCEDURE 
PROCEDURE 
PROCEDURE 


PROCEDURE 
PROCEDURE 
FUNCTI ON 


{TWindow. }CanDoCommand(cmdNumber: TCmdNumber; VAR checklt: BOOLEAN): BOOLEAN; DEFAULT; 

{TW ndow. }CanDoStdCommand(cmdNumber: TCmdNumber; VAR checklt: BOOLEAN): BOOLEAN; DEFAULT; 

{TWindow. }CommitLast; DEFAULT; 

{TWindow. }DoCommand(cmdNumber: TCmdNumber); DEFAULT 

{TWindow. }LoadMenuBar; DEFAULT; 

{TWindow. }MenuEventAt(mousePt: Point); DEFAULT; 

{TWindow. }NewCommand(cmdNumber: TCmdNumber): TCommand; DEFAULT; 

{TWindow. }NewStdCommand(cmdNumber: TCmdNumber): TCommand 

{TWindow. }PerformCommand(newCommand: TCommand); 

{TWindow. }PerformLast(cmdPhase: TCmdPhase); 

{TWindow. }SaveCommand(command: TCommand); {NOTE: do not use the arg after calling this; 
use window.|astCmd instead} 

{TWindow. }SetupMenus; 

{TWi ndow. }UndoLast; 

{TWindow. }WantMenu( menulD: INTEGER; inClipboard: BOOLEAN): BOOLEAN 


{Miscellaneous} 


PROCEDURE 


{TWindow. }AbortEvent; {only QuickPort should override this} 


{Selection Maintenance during commands} 


PROCEDURE 
PROCEDURE 
PROCEDURE 


{Desktop} 


{TWi ndow. }RestoreSel ection: 
{TWindow. }RevealSelection(asMuchAsPossible, doHilite: BOOLEAN) 
{TWi ndow. }SaveSel ection: 


{The following 2 methods assume that we are focused on the window before they are called} 
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001100 
001101 
001102 
001103 
001104 
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001147 
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PROCEDURE {TWindow. }Activate 

PROCEDURE {TWindow. }Deacti vate: 

PROCEDURE {TWindow. }BlankStationery; DEFAULT 

PROCEDURE {TWindow. }StashPicture(highTransit: THighTransit); 


{$1FC LibraryVersion > 20} 
{Desktop Manager Communi cation} 
PROCEDURE {TWindow. }NameToPrefix(VAR error, offset: INTEGER; VAR name, prefix: TFilePath); 
PROCEDURE {TWindow. }PrefixToName( VAR error, offset: INTEGER; VAR prefix, name: TFilePath); 


(*Convert between OS prefix (ie., '-volname-{DxxxTyyy}' and an icon pathname (ie. 
' <diskname<foldernamel<foldername2<...<iconname'). If an error is returned 
offset will point just beyond the part of the name that caused the error, e.g. 
if '<office<forms<expenses' returns erDuplicateName and the offset is 14 
(pointing to the third '<') then there is more than one 'forms' folder on the 
office disk. Error constants are defined above 


NOTE: these methods will likely take a while to execute, since the Desktop Manager 


must be swapped in to process the request. Therefore, you should try to minimize the 


number of times these are called. *) 
{$ENDC} 


{Foci of Attention} 
FUNCTION {TWindow. }CursorFeedback: TCursorNumber; 
PROCEDURE {TWindow. }PickStdCursor 


{Printing} 
PROCEDURE {TWindow. }AcceptNewPrintingl nfo(document: TDocManager; prReserve: TPrReserve); 
PROCEDURE {TWindow. }ChkPr Mismatch; 
PROCEDURE {TWindow. }Get Printer Metrics 
PROCEDURE {TWindow. }Print(panel: TPanel; nixPgRange: BOOLEAN; nixWholeDialog: BOOLEAN); 


{Filtering} 


PROCEDURE {TWindow. }EachActual Part( PROCEDURE DoToObject(filteredObj: TObject)); {For app to implement} 


PROCEDURE {TWindow. }EachVirtual Part( PROCEDURE DoToObject(filteredObj: TObject)); 


PROCEDURE {TWindow. }FilterAndDo(actual Obj: TObject; PROCEDURE DoToObject(filteredObj: TObject)); 


PROCEDURE {TWindow. }FilterDispatch(actual Obj: TObject; image: Tl mage 
PROCEDURE DoToObject(filteredObj: TObject)); 


{I dl e} 
PROCEDURE {TWindow. }I dl eBegin(centiSeconds: LONGINT); 
PROCEDURE {TWindow. }l dl eContinue(centiSeconds: LONGINT); 
PROCEDURE {TWindow. }l dl eEnd(centiSeconds: LONGINT); 


END; 
TDi al ogBox = SUBCLASS OF TWindow 
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{Variables} 
keyResponse: TDi Response; 
menuResponse: TDi Response; 


down! nMai nWi ndowResponse: TDi Response 
freeOnDismissal: BOOLEAN; 


{Creation/ Destruction} 
FUNCTION {TDialogBox. }CREATE(object: TObject; heap: THeap; itsResizability: BOOLEAN 
itsHeight: INTEGER; itsKeyResponse, itsMenuResponse 
itsDownl nMai nW ndowResponse: TDi Response): TDi al ogBox; 


{Attributes} 
{PROCEDURE TDialogBox. GetMinExtent(VAR minExtent: Point; windowlsResizinglt: BOOLEAN); } 


{Display} 
PROCEDURE {TDial ogBox. }Appear 
PROCEDURE {TDial ogBox. }BeDismissed; DEFAULT; 
PROCEDURE {TDialogBox. }Disappear; DEFAULT; 


END; 


TBand = SUBCLASS OF TArea 


{Variables} 
wi ndow: TWi ndow; 
panes: TList {OF TPane}; 
panel: TPanel: 
scroller: TScroller; {the scroll box} 
scroll Dir: VHSel ect; {v if a row of panes with a vertical bar 


h if a column of panes with a horizontal bar} 


{Creation/ Destruction} 
FUNCTION {TBand. }CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itslnnerRect: Rect; 
itsScroller: TScroller; itsDir: VHSelect): TBand 
{PROCEDURE TBand. Free; } 


{Attributes} 
FUNCTION {TBand. }ViewLCd: LONGI NT; 


{Scrolling} 
PROCEDURE {TBand. }OffsetPanes(deltaLPt: LPoint); 
PROCEDURE {TBand. }ScrollBy(deltaLCd: LONGI NT); 
{A TBand can only scroll in one direction; this also moves the thumb} 
PROCEDURE {TBand. }Scrol|]Step(icon: TEnumlcons; deltaLStd: LONGINT); 
PROCEDURE {TBand. }ScrollTo(viewLCd: LONGI NT); 
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Information 


FUNCTION {TBand.}ThumbPos: I NTEGER 
PROCEDURE {TBand. }ThumbTo(newThumbPos: 


{Resizing} 
{PROCEDURE TBand. 
PROCEDURE {TBand. }Resi zePanes( newVi ewLCd: 


END; 


TSideBand = SUBCLASS OF TBand 


{Fields} 
topOrLeft: BOOLEAN; 
{NOTE: SELF.scroller is NIL} 


FUNCTION {TSideBand. }CREATE( object: TObj 
itsDir: VHSelect; 


itsViewLCd: LONGI NT): 


{Attributes} 


Resi zeOutsi de(newOuterRect 


itsTopOrLeft: 
TSideBand; 


| NTEGER) ; 


Rect); } 
LONGI NT); 


ect; heap: THeap; itsPanel: TPanel; itsIlnnerRect: 


BOOLEAN; 


Rect; 


FUNCTION {TSideBand. }CoBand: TBand 
{returns the band adjacent to SELF} 
END; 
TPanel = SUBCLASS OF TArea 
{Variables} {panes are listed row-wise in the panes list} 
wi ndow: TWi ndow 
panes: TList {OF TPane}; 
current Vi ew: TVi ew; {The view seen through SELF: normal or pagi nated} 
view: TVi ew; {The unpaginated view seen through SELF } 
pagi nat edVi ew: TPagi nat edVi ew; {NIL if not previewing margins} 
selection: TSel ection: {the current selection} 
undoSel ection: TSel ection: {the selection to be restored for an undo/redo} 
bands: ARRAY[VHSelect] OF TList; {redundant... bands[v].at(1) = top row of panes} 
scroll Bars: ARRAY[VHSelect] OF TScroll Bar; {scroll Bars[(v,h)]--the (vert, horiz) scroll bars} 
abilities: ARRAY[VHSelect] OF TAbilities; {[aBar, aScroll, aSplit, aResize]} 
mi ni nner Di agonal : Point; 
resizeBranch: TBranchArea; {the branch that my botRight resizes, or NIL} 
zoomed: BOOLEAN; 
zoomFactor: TScaler 
previ ewMode: TPreviewMode 
lastClick: RECORD {describes the pane the user last clicked} 
CASE gotPane: BOOLEAN OF 
TRUE: (clickPane: TPane); {the last pane the user clicked on} 
FALSE: (clickPt: Point); {the innerRect.topLeft of lastClick. pane 
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in the case where the lastClick. pane was 


deleted} 
END; 
content Rect: Rect; {part of the innerRect not containing side bands} 
tl Si deBandSi ze: Point; {size of topLeft side bands} 
br Si deBandSi ze: Point: 


{NOTE: The sideband sizes refer to the size of the innerRect of the side band 
therefore a size of -1 means there is no side band on that side} 
deletedSplits: TArray; {If NIL, don't remember splits that go away because the pane 
shrinks. Otherwise, this should be a TArray with recordBytes 
2. This is initialized to NIL in TPanel. CREATE; clients can 
allocate an array and change the field if they desire. } 


{Creation/ Destruction} 

FUNCTION {TPanel. }CREATE(object: TObject; heap: THeap; itsWindow: TWindow 

minHei ght, minWidth: INTEGER; itsVAbilities, itsHAbilities: TAbilities): TPanel 

{PROCEDURE TPanel. Free; } 

PROCEDURE {TPanel. }HaveView( view: TVi ew) 

FUNCTION {TPanel.}NewView(object: TObject; itsExtent: LRect; itsPrintManager: TPrintManager 

itsDfltMargins: LRect; itsFitPerfectl yOnPages: BOOLEAN): TView 
FUNCTION {TPanel. }NewStatusView(object: TObject; itsExtent: LRect): TView 


{Attributes} 

PROCEDURE {TPanel. }ComputeContent Rect; 

PROCEDURE {TPanel. }DecideAbout Bars(newOuterRect: Rect); {Decide if to have scroll bars & resize icon} 
{PROCEDURE TPanel. Get MinExtent(VAR minExtent: Point; windowlsResizinglt: BOOLEAN); } 

{PROCEDURE TPanel. GetBorder(VAR border: Rect); } 

FUNCTION {TPanel. }FindBranchThatIl sResized: TBranchArea: 

FUNCTION {TPanel.}PaneShowing(anLRect: LRect): TPane; {Returns first pane showing an part 

of anLRect, else NIL} 
PROCEDURE {TPanel. }Seti nnerRect(newlnnerRect: Rect); OVERRIDE; 
PROCEDURE {TPanel. }SetOuterRect(newOuterRect: Rect); OVERRIDE; 


{Paneling the window} 
FUNCTION {TPanel. }Divide(vhs: VHSelect; 
fromEdgeOfPanel: INTEGER; units: TUnitsFromEdge 
whoCanResizelt: TResizability; 
mi nSize: INTEGER; itsVAbilities, itsHAbilities: TAbilities): TPanel 
PROCEDURE {TPanel. }Insert(panel: TPanel; vhs: VHSelect; 
fromEdgeOfPanel: INTEGER; units: TUnitsFromEdge 
whoCanResizelt: TResizability); {Resizes both to share my space} 
PROCEDURE {TPanel. }Remove; {Does not Free SELF; Expands sibling to fill my space} 
PROCEDURE {TPanel.}Replace(panel: TPanel); {Does not Free SELF; Resizes panel to fit my old space} 


{But toning} 
{FUNCTION  TPanel. DownAt(mousePt: Point): BOOLEAN; } 
PROCEDURE {TPanel. }Downl nSizeBox( mousePt: Point); 
PROCEDURE {TPanel. }HitScroller(vhs: VHSelect; mousePt: Point; scroller: TScroller; icon: TEnuml cons); 
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(* 


{Selecting} 


PROCEDURE {TPanel 
PROCEDURE {TPanel 
{TPanel. 


FUNCTI ON 


{Cursor tracking} 
FUNCTI ON 


{Display} 
{PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTI ON 
PROCEDURE 
{PROCEDURE 
PROCEDURE 
PROCEDURE 


{Page- Previ ewi ng} 


PROCEDURE {TPanel. 


{Printing} 
PROCEDURE 


{Scrolling} 
PROCEDURE 
PROCEDURE 


{inArea must be a TBand or a TPane 


{TPanel. 

TPanel. 
{TPanel. 
{TPanel. 
{TPanel. 
{TPanel. 
{TPanel. 

TPanel. 


{TPanel. 
{TPanel. 


{TPanel. 


{TPanel. 
{TPanel. 
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}Begi nSel ection; 
}BeSelectPanel(inSelect Window: BOOLEAN); 
}NoSelection: TSelection; *) 


}CursorAt(mousePt: Point): TCursorNumber 


Frame: } 
}Highlight(selection: TSelection; highTransit: 

{ this highlights the selection on all pads } 
}Invalidate; 

{ this invalidates the whole panel } 
}lnval LRect(]RectI nView: LRect); 

{ this invalidates the given LRect on all pads } 
}OKToDrawl n(| RectI nView: LRect): BOOLEAN 

{ If this returns FALSE, commands must InvalLRect or XOR 
}OnAl | PadsDo( PROCEDURE DoOnThePad); 

Refresh(rActions: TActions; highTransit: THighTransit); } 
}Rescroll 
}Set ZoomFactor(zoomNumerator, 


THi ghTransit); 


not Draw or Erase } 


zoomDenomi nator: Point); 


}Preview(newMode: TPreviewMode); 


}PrintView(printPref: TPrReserve); 


}AutoScroll(mousePt: Point); 
}DoScrolling(inArea: TArea; 
hOk, vOk: 


itsPane: TPane; 
BOOLEAN; VAR deltaLPt: LPoint); 
if a TPane then inArea=itsPane 


if a TBand then itsPane is any one of the band's panes} 


FUNCTI ON 


{TPanel. 


}PaneToScroll(VAR anLRect: LRect; hMinToSee, vMinToSee: INTEGER): TPane 


{Returns the pane to scroll for showing the minimum desired part ofLRect; 
if that part is already showing, it returns NIL; 
NOTE: anLRect is NOT changed} 


PROCEDURE 


{TPanel. 


}RevealLRect( VAR anLRect: LRect; hMinToSee, vMinToSee: I NTEGER) 


{Show at least the desired part of the LRect in the pane returned by PaneToShow 
NOTE: anLRect is NOT changed} 


{Splitting} 


PROCEDURE 
PROCEDURE 
PROCEDURE 
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{TPanel. }CleanUpPanes(deleteList: TList); 
{TPanel.}MakeBand(vhs: VHSelect; scroller, prevScroller: TScroller); 
{TPanel. }MoveSplitBefore(scroller: TScroller; newSkwrCd: I NTEGER) 
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001340 FUNCTION {TPanel.}NewBand(heap: THeap; mylnnerRect: Rect; 

001341 scroller: TScroller; vhs: VHSelect): TBand 

001342 FUNCTION {TPanel.}NewPane(heap: THeap; innerRect: Rect; viewedLRect: LRect): TPane 
001343 PROCEDURE {TPanel. }RemakePanes 

001344 PROCEDURE {TPanel. }RememberSplit(vhs: VHSelect; atCd: | NTEGER) 

001345 PROCEDURE {TPanel. }RepaneOrt hogonal Bands(vhs: VHSel ect); 

001346 PROCEDURE {TPanel. }RestoreSplits; 

001347 

001348 {Side Bands} 

001349 PROCEDURE {TPanel. }ShowSideBand(vhs: VHSelect; topOrLeft: BOOLEAN; size: INTEGER; viewLCd: LONGINT); 
001350 PROCEDURE {TPanel.}SideBandRect(vhs: VHSelect; topOrLeft: BOOLEAN; VAR bandRect: Rect) 
001351 {returns the innerRect of the side band, given SELF. contentRect} 
001352 

001353 {Resizing} 

001354 PROCEDURE {TPanel.}ResizeBand(vhs: VHSelect; band: TBand; newViewLCd: LONGI NT; 
001355 flnvalidate: BOOLEAN) 

001356 {PROCEDURE TPanel. Resizelnside(newlnnerRect: Rect); } 

001357 {PROCEDURE TPanel. ResizeOutside(newOuterRect: Rect); } 

001358 

001359 END; 

001360 

001361 

001362 TPane = SUBCLASS OF TPad 

001363 

001364 {Variables} 

001365 current View: TVi ew; {The view that is currently} 
001366 panel: TPanel; {The containing panel } 

001367 

001368 {Creation/ Destruction} 

001369 FUNCTION {TPane. }CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itsInnerRect: Rect; 
001370 itsViewedLRect: LRect): TPane 

001371 PROCEDURE {TPane. }HaveView(view: TVi ew) 

001372 

001373 {Attributes} 

001374 PROCEDURE {TPane. }GetScrollLimits(VAR viewedLRect, scrollableLRect: LRect) 
001375 {PROCEDURE TPane. SetZoomFactor(zoomNumerator, zoomDenomi nator: Point); } 
001376 

001377 {Selecting} 

001378 PROCEDURE {TPane. }}MouseTrack( mPhase: TMousePhase; mousePt: Point); 

001379 {assumes mousePt is in the pane's innerRect} 

001380 

001381 {Cursor tracking} 

001382 FUNCTION {TPane. }CursorAt(mousePt: Point): TCursorNumber 

001383 

001384 {Display} 

001385 {PROCEDURE TPane. Refresh(rActions: TActions; highTransit: THighTransit); } 
001386 

001387 {Resizing} 
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001388 PROCEDURE {TPane. }Resize(newlnnerRect: Rect; vhs: VHSelect); 

001389 

001390 {Scrolling} 

001391 PROCEDURE {TPane. }Scrol|l By(VAR deltaLPt: LPoint); 

001392 {NOTE: deltaLPt is NOT changed; also moves the thumb(s) } 

001393 PROCEDURE {TPane. }Scroll ToReveal(VAR anLRect: LRect; hMinToSee, vMinToSee: INTEGER); 
001394 {NOTE: anLRect is NOT changed} 

001395 END; 

001396 

001397 

001398 TMarginPad = SUBCLASS OF TPad 

001399 

001400 {Variables} 

001401 vi ew: TVi ew; {The view seen on the BODY of this page} 

001402 pageNumber: LONGI NT; 

001403 bodyPad: TBodyPad; 

001404 

001405 {Creation/ Destruction} 

001406 FUNCTION {TMarginPad. }CREATE(object: TObject; heap: THeap): TMargi nPad 

001407 

001408 PROCEDURE {TMarginPad. }Rework(itsView: TView; itsOrigin: Point; itsRes: Point; 
001409 itsPageNumber: LONGINT; itsZoomFactor: TScaler; itsPort: GrafPtr) 
001410 PROCEDURE {TMarginPad. }SetForPage(itsPageNumber: LONGINT; itsOrigin: Point); 
001411 

001412 {Di spl ay} 

001413 {PROCEDURE TMarginPad. Focus; } 

001414 

001415 {Process termination and Debugging Assistance} 

001416 {PROCEDURE TMarginPad. Crash; } 

001417 {FUNCTION TMarginPad. BindHeap(activeVsClip, doBind: BOOLEAN): THeap; } 

001418 

001419 END; 

001420 

001421 

001422 TBodyPad = SUBCLASS OF TPad 

001423 

001424 {Variables} 

001425 marginPad: TMarginPad; {the page shell whose body | am} 

001426 nonNull Body: Rect; {the portion of the pad in the range of the mapped view 
001427 BodyPad.innerRect = nonNull Body unless manual pagebreak or end-of-view forces 
001428 a shortage of view to map into entire inner rect} {Someday make this comment comprehensible} 
001429 

001430 {Creation/ Destruction} 

001431 FUNCTION {TBodyPad. }CREATE(object: TObject; heap: THeap; itsMarginPad: TMarginPad): TBodyPad 
001432 PROCEDURE {TBodyPad. }Recompute; 

001433 PROCEDURE {TBodyPad. }SetForPage(itsPageNumber: LONGI NT); 

001434 

001435 {Display} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 85 of 1012 


001436 
001437 
001438 
001439 
001440 
001441 
001442 
001443 
001444 
001445 
001446 
001447 
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001451 
001452 
001453 
001454 
001455 
001456 
001457 
001458 
001459 
001460 
001461 
001462 
001463 
001464 
001465 
001466 
001467 
001468 
001469 
001470 
001471 
001472 
001473 
001474 
001475 
001476 
001477 
001478 
001479 
001480 
001481 
001482 
001483 
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{PROCEDURE TBodyPad. Focus; } 


END; 


TScroller = SUBCLASS OF TObj ect 


{Variables} 
scroll Bar: TScroll Bar; 
band: TBand; 
sBoxl D: TSBoxl D; 


{Creation/ Destruction} 
FUNCTI ON 


{PROCEDURE TScroller. Free; } 


{Attributes} 


{the scroll bar of which it is part} 
{the object that can respond to scroll events} 
{the scroll-bar-library representation} 


{TScroller. }CREATE( object: TObject; heap: THeap; itsScrollBar: TScroll Bar; itsld: TSBoxlD) 
: TScroller; 


PROCEDURE {TScroller. }GetSize(VAR boxRect: Rect); 


FUNCTI ON 


{TScroller.}Scroll Dir: VHSelect; 


PROCEDURE {TScroller. }SetSize(ownerRect: Rect); 


FUNCTI ON 


{But toning} 


{TScroller. }ThumbRange: INTEGER 


PROCEDURE {TScroller. }TrackSkewer(mousePt: Point; VAR newSkwrCd: INTEGER 


VAR scroller, prevScroller: TScroller); 


PROCEDURE {TScroller. }TrackThumb( mousePt: Point; VAR oldThumbPos, newThumbPos: INTEGER); 


{Display} 


PROCEDURE {TScroller. }Filllcon(icon: TEnuml cons; f Black: BOOLEAN); 
PROCEDURE {TScroller. }MoveThumb( newThumbPos: I NTEGER) 


{Splitting} 


PROCEDURE {TScroller. }ResplitAt(newSkwrCd: INTEGER; prevScroller: TScroller); 
PROCEDURE {TScroller. }SplitAt(nmewSkwrCd: INTEGER; VAR nextScroller: TScroller) 


END; 


TScrollBar = SUBCLASS OF TObj ect 


{Variables} 
firstBox: TScroller 
isVisible: BOOLEAN; 


{Creation/ Destruction} 
FUNCTI ON 


{the rest are found via the SB Library} 
{TRUE iff this scroll bar should be drawn} 


{TScroll Bar. }CREATE(object: TObject; heap: THeap; vhs: VHSelect; outerRect: Rect 


itsVisibility: BOOLEAN): TScroll Bar 
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PROCEDURE {TScroll Bar. }ChangeVisibility(needsBothBars: BOOLEAN 
bandOuterRect: Rect; itsAbilities: TAbilities); 


{But toning} 


FUNCTION {TScroll Bar. }DownAt( mousePt: Point; VAR scroller: TScroller; VAR icon: TEnumlcons): BOOLEAN 


{Display} 
PROCEDURE {TScroll Bar. }Draw 
PROCEDURE {TScroll Bar. }Erase 


END; 


TMenuBar = SUBCLASS OF TObject {only one instance exists (menuBar) } 


{Variables} 
isLoaded: ARRAY [1..maxMenus] OF BOOLEAN; {TRUE iff the i'th menu has been inserted} 
mapping: TArray {OF TWmgrCmd}; {maps command number to menu & item indices} 
numMenus: INTEGER; {how many menus} 
numCommands: INTEGER; {how many commands in all menus together} 


{Creation/ Destruction} 
FUNCTION {TMenuBar. }CREATE(object: TObject; heap: THeap; itsScanner: TFileScanner): TMenuBar 


{Attributes} 
PROCEDURE {TMenuBar. }Check(cmdNumber: TCmdNumber; checked: BOOLEAN); 
PROCEDURE {TMenuBar. }Enable(cmdNumber: TCmdNumber; canBeChosen: BOOLEAN) 
PROCEDURE {TMenuBar. }BuildCmdName(destCmd, templ ateCmd: TCmdNumber; param TPString) 
{if paramis NIL, use the default} 
FUNCTION {TMenuBar. }GetCmdName(cmdNumber: TCmdNumber; pName: TPString): BOOLEAN 
{returns TRUE iff cmdNumber is found (pName will be empty); 
pName can be NIL, which will save the overhead of returning the 
menu item, for case where you just want to see if it exists} 
PROCEDURE {TMenuBar. }PutCmdName(cmdNumber: TCmdNumber; pName: TPString); 


{But toning} 
FUNCTION {TMenuBar. }CmdKey(ch: CHAR): TCmdNumber; 
FUNCTION {TMenuBar. }DownAt( mousePt: Point): TCmdNumber; 


{Display} 
PROCEDURE {TMenuBar. }Draw 
PROCEDURE {TMenuBar. }EndCmd: 
PROCEDURE {TMenuBar. }Hi ghlightMenu( withCmd: TCmdNumber); 
{call this when the user presses the CLEAR key for example, to highlight 
the appropriate menu title; you should then call window, DoCommand with 
an apropriate command number. } 


{Loading} 
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001532 
001533 
001534 
001535 
001536 
001537 
001538 
001539 
001540 
001541 
001542 
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001560 
001561 
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001570 
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001575 
001576 
001577 
001578 
001579 


PROCEDURE {TMenuBar. }Del ete( menul D: 
PROCEDURE {TMenuBar 
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PROCEDURE {TMenuBar. }Unl oad; 


{For Future Use} 
{TMenuBar. }MenuWi thi D( menul D: 


FUNCTI ON 
END; 


INTEGER): 


INTEGER); 
.}lnsert(menulD, beforeld: 


| NTEGER) ; 


Ptr: 


{$1FC LibraryVersion <= 20 AND FALSE} {do it this way in case we need it back for Pepsi version} 
TFont = SUBCLASS OF TObj ect 


{Variables} 
family: 


| NTEGER; 


{Creation/ Destruction} 


FUNCTI ON 


END; 


{$ENDC} 


VAR 


{ GLOBAL VARIABLES -- 


acti veW ndowl D: 
all owAbort: 
aut oBreakPen: 


blinkOffCentiSecs: 


bli nkOnCenti Secs: 
boundCli pboard: 
boundDocument: 
cancel String: 
clickState: 
clipboard: 
clipPrintPref: 

cl osedBySuspend: 
cl osedDocument: 


cornerNumber Style: 


countryCode: 
current Document: 


current Window: 
cursorShape: 
deferUpdate: 
dfltNewHeadi ng: 
docList: 
event Ti me: 
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{TFont. }CREATE( obj ect: TObj ect; 


EFFECTIVELY, 


TWi ndowl D; 
BOOLEAN; 
PenState; 
LONGI NT; 
LONGI NT; 
TClipboard; 
TDocManager; 
STRING[ 20]; 
TClickState; 
TClipboard; 
TPrReserve; 
BOOLEAN; 
TDocManager; 
TTypeStyle; 
INTEGER; 
TDocManager; 


TWi ndow; 

TCursorNumber: 

BOOLEAN; 

STRING[ 20]; {+SW+} 
TList {OF TDocManager}; 
LONGI NT; 


heap: THeap; itsFamily: 


{Font Manager TFam} 


INTEGER): TFont; 


FIELDS OF CLASS TProcess } 


{The wmgr!D field of the active document, or 0} 

{Il ff TRUE, allow aborts} 

{pen to use to draw automatic page breaks} 

{Centiseconds to hide the insertion point} 

{Centiseconds to display the insertion point} 

{The clipboard whose data segment is bound, or NIL} 

{The document whose data segment is bound, or NIL} 

{The word "Cancel" for use in buttons} 

{Shifts and repeats of the last mouse click} 

{The Clipboard document manager} 

{the print-preference for the clipboard} 

{Iff TRUE, closedDocument was just suspended} 

{If not NIL, this document was just put away} 

{TypeStyle used for page-numbers in page-previ ew} 

{The country code as read from phrase file} 

{The active document OR if running in background, the 
document to use; otherwise NIL} 

{current Document. window, OR NIL} 

{The cursor shape as recorded by TProcess. ChangeCursor} 

{set TRUE by app to defer updating while typing} 

{Default value for newly-created headings} 

{The documents that are open} 

{The time of the most recent WM event} 
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event Type: | NTEGER; {The type number of the most recent WM event } 
{$1 FC f DbgABC} 
fExperi menting: BOOLEAN; {IF TRUE, enable zoom experimentation etc. } 
f Count Heap: BOOLEAN; {Iff TRUE and IFC fCheckHeap, count objects once per cmd} 


{$ENDC} 


{$1FC LibraryVersion <= 20 AND FALSE} {do it this way in case we need it back for the Pepsi version} 


fonts: ARRAY [0..maxFonts] OF TFont 
{$ENDC} 
genClipPic: BOOLEAN; {lff TRUE, we are generating the Clipboard picture} 
hi ghLevel: ARRAY [BOOLEAN] OF THighTransit; {TRUE=>hOffToOn, FALSE=>hOf f ToDi m} 
hi ghToggle: ARRAY [BOOLEAN] OF THighTransit; {TRUE=>hOffToOn, FALSE=>hOnToOff } 
idl eTi me: LONGI NT; {The time we finished processing the last user input} 
inBackground: BOOLEAN; {lff TRUE, currently running in background} 
|i mboPen: PenState; {pen to use to fill limbo area in paginated view} 
manual BreakPen: PenState; {pen to use to draw manual page breaks} 
marginPattern: LPattern; {pattern to use to fill margins in paginated view} 
menuBar: TMenuBar; {The menus of the application and the Clipboard} 
my Process! D: LONGI NT; {The 0S ID of this process} 
my Tool: LONGI NT; {The tool number of this tool} 
nor mal Pen: PenState; {pen state resulting from PenNor mal } 
okString: STRING[ 20]; {The word "OK" for use in buttons} 
phraseFile: TFileScanner: {The Main Phrase File TFil eScanner} 
process: TProcess; {The process object of this process} 
screenRi ght Edge: I NTEGER; {720 for Lisa 1.0 screen} 
scroll Rgn: RgnHandl e; {what needs to be refreshed because of scroll} 
stdMargins: LRect; {standard page- margins, in screen pixels} 
suspendSuf fix: ARRAY [1..maxSegments] OF STRING[3] 
theBodyPad: TBodyPad; {current BodyPad being written to} 
theMargi nPad: TMargi nPad; {current MarginPad being written to} 
tool Name: STRING[ 67]; {The name of the tool } 
tool Prefix: TFilePath; (*The prefix '{Tnn}' of the OS path name of the tool*) 
tool Vol ume: TFilePath; {The volume '-name-' on which the tool resides} 
var Page: STRING[ 20]; {+SW+} {The string 'PAGE', for use in heading variables} 
varTitle: STRING[ 20]; {+SW+} {The string 'TITLE' for use in heading variables} 
wordDelimiters: STRI NG[ 67]; {The delimiters of a Lisa "word" in this language} 
PROCEDURE GetPrefixPart(wholeName: $255; VAR filePart: TFilePath); (*' {prefix}'*) 


FUNCTION Tool OfFile( wholeName: $255): LONGI NT 
FUNCTION Tool Of Process(processid: LONGINT): LONGI NT 


{ Used to 
These 


PROCEDURE 
PROCEDURE 
PROCEDURE 


insert comments into the Universal Graph of Clipboard, so LisaDraw can understand it; 
procedures only insert comment when we are generating the Universal Graph } 
{ beginning of a series of text drawing ops that should be grouped } 


PicTextBegin(alignment: TAlignment); 
Pi cTextEnd; { end of series } 
Pi cGrpBegi n; { beginning of a series of grouped objects } 
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001628 PROCEDURE PicGrpEnd; { end of series } 

001629 

001630 PROCEDURE InitProcess 

001631 

001632 FUNCTION GetTi me: LONGI NT; 

001633 {This function returns the same "time" as is used in events (see global variable eventTi me), 
001634 and in the idle | oop} 

001635 

001636 

001637 | MPLEMENTATI ON 

001638 

001639 {$l LI BTK/ UABC2, TEXT} {TProcess-TDocDirectory-TDocManager-TCli pboard-TCommand- TCut CopyCommand- 
001640 TPast eCommand} 

001641 {$l LI BTK/ UABC3, TEXT} {Tl mage-TVi ew- TPagi nat edVi ew- TPageVi ew- TPrint Manager- THeadi ng- TSel ecti on} 
001642 {$1 LIBTK/ UABC4, TEXT} {TWi ndow- TDi al ogBox- TMenuBar- TFont } 

001643 {$1 LIBTK/ UABC5. TEXT} {TPanel - TBand- TPane- TMarginPad- TBodyPad- TScroller-TScroll Bar} 

001644 

aie ( FRR RR ERK KE 

001646 {$l UABC2. TEXT} {TProcess-TDocDirectory-TDocManager-TCli pboard-TCommand- TCut CopyCommand- TPast eCommand} 
001647 {$l UABC3. TEXT} {Tl mage-TVi ew- TPagi nat edVi ew- TPageVi ew- TPri nt Manager- THeadi ng- TSel ecti on} 
001648 {$1 UABC4, TEXT} {TWi ndow- TDi al ogBox- TMenuBar- TFont } 

001649 {$l UABC5. TEXT} {TPanel - TBand- TPane- TMarginPad- TBodyPad- TScroller-TScroll Bar} 

001650 HARK KK KK KK) 

001651 

001652 END. 

001653 

End of File -- Lines: 1653 Characters: 71219 
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000001 {INCLUDE FILE UABC2 -- | MPLEMENTATION OF UABC} 

000002 {Copyright 1983, 1984, Apple Computer, Inc. } 

000003 

000004 {TProcess-TDocDirectory-TDocManager-TCli pboard-TCommand- TCut CopyCommand- TPast eCommand} 
000005 

000006 


000007 {Segments: SgABCini(tialize and Terminate), SgABCres(ident), SgABCc(o)Id, SgABCdbg, SgABCpri (nti ng) } 
000008 


000009 {$IFC fRngABC} 

000010 {$R+} 

000011 {$ELSEC} 

000012 {$R-} 

000013 {$ENDC} 

000014 

000015 {$lFC fSymABC} 

000016 {$D+} 

000017 {$ELSEC} 

000018 {$D-} 

000019 {$ENDC} 

000020 

000021 CONST toolKitType = 9; 

000022 

000023 { picture comment IDs for pasting into LisaDraw } 
000024 cPi cGeDwg = } 

000025 cPicTxtBegin = 101; 

000026 cPicTxtEnd = 102; 

000027 cPicGrpBegin = 103; 

000028 cPicGrpEnd = 104 

000029 

000030 TYPE TPrPrfAlias = RECORD {Alias for Print Preference} 
000031 CASE INTEGER OF 

000032 {$IFC libraryVersion <= 20} { PEPSI } 

000033 1: (prPrf: TPrPrf; prins: TPrins); 
000034 {$ELSEC} 

000035 1: (prPrf: TPrRec) 

000036 {$ENDC} { 5 PRI N G} 

000037 2: (reserve: TPrReserve) 

000038 END; 

000039 

000040 TMapTable = RECORD {Alias for menuBar. mapping TArray} 
000041 header: TArrayHeader 

000042 table: ARRAY [1..8000] OF TWmgrCmd; 
000043 END; 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
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000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 
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TMapPtr = *TMapTabl e; 
TMapHandle = *TMapPtr 


VAR 
alerts: 
event: 

{$1 FC f DbgABC} 
hadToBindClip: 

{$ENDC} 
scrRgniForDrawHdgs: 
scrRgn2ForDrawHdgs: 
wmgr Menus: 
cSelecti on: 
picData: 


TAlertFile: {The Alert Manager alert handle for the Main Phrase File} 

Event Record; {The last event received by this process} 

BOOLEAN; {BindHeap had to bind the Clipboard} 

RgnHandl e; {Reserved for use dy TPaginatedVi ew. AdornPageOnScreen} 

RgnHandl e; {Reserved for use dy TPaginatedVi ew. AdornPageOnScreen} 

ARRAY [1..maxMenus] OF Menul nfo; 

TClass; {The TClass of TSelection, used by TPasteCmd. Perform} 

TH; {Pre-allocated handle on MainHeap used for picture 
comments} 


PROCEDURE I nAll MenusDo(iffLoaded: BOOLEAN: theCommand: TCmdNumber 


{$$ sScroll} 


PROCEDURE doProc(VAR menu: Menul nfo; itemlndex: INTEGER)); FORWARD; 


PROCEDURE PreSbList(VAR sbList: TSbList; scroll Bar: TScroll Bar); 


BEGIN 
{$1 FC fTrace}BP(1); 


{$ENDC} 


sbList.hz := POINTER( ORD(scroll Bar. Heap) ); 
IF scroll Bar.firstBox = NIL THEN 


sbList. hsbFst 
ELSE 
sbList. hsbFst 


= hsbNi 


:= POINTER(scroll Bar. first Box. sBoxl D) 


{$I FC fTrace}EP; {$ENDC} 


END; 


{$§ sScroll} 


PROCEDURE PostSbList(sbList: TSbList; scroll Bar: TScroll Bar); 
VAR scroller: TScroller 


BEGIN 
{$I FC fTrace}BP(1); 
IF sbList. hsbFst = 


scroller := NIL 


ELSE 
scroller := POl 
scroll Bar. first Box 


{$ENDC} 
hsbNil THEN 


NTER(RefconSb(sbList. hsbFst)); 
:= scroller; 


{$I FC fTrace}EP; {$ENDC} 


END; 


Appl 
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000092 {$8 sStartup} 
000093 PROCEDURE GetPrefixPart{(wholeName: $255; VAR filePart: TFilePath)}; (*' {prefix}'*) 


000094 (* This works ONLY on Desktop Manager file names of the form'-volname-{prefix}suffix' *) 
000095 VAR centerHyphen: INTEGER 

000096 BEGIN 

000097 {$1 FC fTrace}BP(1); {$ENDC} 

000098 centerHyphen := Pos('-{', whol eName); 

000099 filePart := Copy(wholeName, centerHyphent1, Pos('}', wholeName) - centerHyphen) 

000100 {$1 FC fTrace}EP; {$ENDC} 

000101 END; 

000102 

000103 


000104 {$$ sCldinit} 
000105 FUNCTION Tool OfFile{(wholeName: $255): LONGI NT}; 


000106 VAR tool Number: LONGI NT; 

000107 tool Prefix: TFilePath; 

000108 cvResult: TConvResult; 

000109 BEGIN 

000110 {$I FC fTrace}BP(7); {$ENDC} 

000111 Get PrefixPart(wholeName, tool Prefix); 

000112 Delete(tool Prefix, 1, 2); (* The '{T' *) 
000113 Delete(tool Prefix, Length(toolPrefix), 1); (* The final '}' *) 
000114 StrToLInt(@tool Prefix, toolNumber, cvResult); 
000115 IF cvResult <> cvValid THEN 

000116 Tool Of File := 0 

000117 ELSE 

000118 Tool Of File := tool Number 

000119 {$1FC fTrace}EP; {$ENDC} 

000120 END; 

000121 

000122 


000123 {$S sCldlnit} 
000124 FUNCTION Tool OfProcess{(processid: LONGI NT): LONGI NT}; 


000125 VAR prcsinfo: Procl nf oRec 

000126 error: INTEGER; 

000127 BEGIN 

000128 {$1 FC fTrace}BP( 6); {$ENDC} 

000129 Info Process(error, processID, prcsinfo) 
000130 IF error > 0 THEN 

000131 Tool Of Process := 0 

000132 ELSE 

000133 Tool Of Process := Tool Of File(prcsi nfo. progPathname) ; 
000134 {$1 FC fTrace}EP; {$ENDC} 

000135 END; 

000136 

000137 


000138 {$l FC fDbgABC} 
000139 {$8 SgABCdbg} 
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PROCEDURE ReportEvent; 


BEGI 


END; 


{$$ 


VAR winTitle: $tr255; 
N 
Write(tool Name, ' P=#', myProcessid:1, ' received '); 


WTH event DO 


BEGIN 

CASE what OF 
buttonDown: Write('Button-down'): 
but tonUp: Write(' Button-up') 
folderActivate: Write('Activate' ) 
folderDeacti vate: Write('Deactivate'); 
folder Moved: Write(' Window- moved' ) 
folderUpdate: Write('Update'); 
key Down: Write('Key-press'); 
filerEvent: Write('Desktop') 
OTHERW SE Write(' Miscellaneous’) 
END; 

Write(' event for the '); 


1F who 


= alertFolder THEN 


WriteLn('Alert Box') 


ELSE 


1F who = dialogFolder THEN 
WriteLn(' Dialog Box') 


ELSE 


1F who 


= scrapFolder THEN 


WriteLn('Clipboard' ) 


ELSE 


1 F who 


= menuFolder THEN 


WriteLn('Menu Bar' ) 


ELSE 


BEGIN 

GetFldrTitle(who, winTitle); 
WriteLn('window titled "', winTitle, '"'); 
END; 


END; 


SgABCdbg} 


PROCEDURE ReportFilerEvent(flrParams: FilerExt); 


BEGI 


N 
Write(' 


'); 


WTH flrParams DO 


BEGIN 

CASE theFlrOp OF 
fcClose: Write('Close '); 
f cCopy: Write(' Copy mt Be 
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fcDfClose: Write('Doc File Close'); 
f cNone: Write(' Open Tool '); 
fcPut: Write(' Put '); 
f cResume: Write(' Open Doc Bs 
fcShred: Write(' Shred 5 
f cSuspend: Write(' Suspend '); 
fcTermi nate: Write(' Terminate '); 
OTHERW SE Write(' Unknown!!! ae 
END; 


{$1FC LibraryVersion <= 20} 
WriteLn(' theErr=', theErr:1, ' theDF=', theDF:1) 


WriteLn(' thePrefix="', thePrefix, '"'); 
{$ELSEC} 
WriteLn(' theErr=', theErr:1, ' theOffset=', theOffset:1, ' theDF=', theDF:1) 
WriteLn(' thePassword="', thePassword, '"'); 
WriteLn(' thePrefix="', thePrefix, '"'); 
WriteLn(' theResult="', theResult, '"'); 
{$ENDC} 
END; 
END; 
{$ENDC} 
{$$ sError} 
PROCEDURE Al ErrProc; 
BEGIN 
StopAlert(alerts, 2); 
process. Compl ete( FALSE); 
END; 
{$$ sCl dl nit} 
FUNCTION ExpandHeap( heap: THeap; bytesNeeded: INTEGER): INTEGER 
VAR alias: RECORD CASE INTEGER OF 1: (address: TPPrelude); 2: (high, low: INTEGER) END 
preludePtr: TPPrelude 
ol dHeapSi ze: LONGI NT; 
newHeapSi ze: LONGI NT; 


BEGIN 
{$1 FC fTrace}BP(1); {$ENDC} 
alias.address := POINTER( ORD( heap) ); 
alias.low := 0; 
preludePtr := alias. address 


{$1 FC fDbgABC} 
IF boundDocument.dataSegment.preludePtr <> preludePtr THEN 


ABCBreak(' boundDocument''s preludePtr <> preludePtr in ExpandHeap', ORD( heap) ) 


{$ENDC} 
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ol dHeapSize := CbOfHz(POINTER(ORD( heap) )); 
boundDocument. ExpandMemor y( bytesNeeded) 


WTH boundDocument. dataSegment. preludePtr* DO 
newHeapSize := docSize - preludeSize 


ExpandHeap := newHeapSize - oldHeapSize 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$8 SgABCcl d} 
PROCEDURE PicTextBegin{(alignment: TAlignment) }; 
TYPE TpByte = “Byte 
ThByte = “TpByte; 


VAR FEalign: Byte; 
BEGIN 
IF genClipPic THEN 
BEGIN 
FEalign := ORD( alignment) + 1; 
IF FEalign > 3 THEN 
FEalign := 1; {aleft} 
ThByte(picData)** := FEalign; {currently, picData is always a handle to 1 byte} 
{$1FC LibraryVersion <= 20} 
PicComment(cPicTxtBegin, SI ZEOF(FEalign), Handle(picData)); 
{$ELSEC} 
PicComment(cPicTxtBegin, SI ZEOF(FEalign), QDHandle(picData)); 
{$ENDC} 
END; 


END; 


{$$ SgABCcl d} 
PROCEDURE PicTextEnd: { end of series } 
BEGIN 
IF genClipPic THEN 
PicComment(cPicTxtEnd, 0, NIL) 
END; 


{$$ SgABCcl d} 
PROCEDURE PicGrpBegin; { beginning of a series of grouped objects } 
BEGIN 
IF genClipPic THEN 
PicComment(cPicGrpBegin, 0, NIL); 
END; 
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000284 

000285 

000286 {$8 SgABCcl d} 

000287 PROCEDURE PicGrpEnd; { end of series } 
000288 BEGIN 

000289 IF genClipPic THEN 

000290 PicComment(cPicGrpEnd, 0, NIL) 

000291 END: 

000292 

000293 

000294 {$$ sError} 

000295 FUNCTION FilerReason(error: INTEGER): FReason; 
000296 BEGIN 


000297 {$1 FC fTrace}BP(1); {$ENDC} 

000298 FilerReason := all Ok 

000299 IF error > 0 THEN 

000300 CASE error OF 

000301 309, erNoDiskSpace: 

000302 FilerReason := noDiskSpace; 
000303 306, 311, 315, erNoMemory: 

000304 FilerReason := noMemory 
000305 {$1FC LibraryVersion > 20} 

000306 1294, erWrongPassword 

000307 FilerReason := wrongPassword 
000308 {$ENDC} 

000309 erBadData: FilerReason := badData; 
000310 erPassword, erVersion, 

000311 955, 957, 958, erCantRead 

000312 FilerReason := cantRead 
000313 961, 962, erCantWrite: 

000314 FilerReason := cantWrite; 
000315 erDirtyDoc: FilerReason := dirtyDoc 
000316 erNoMoreDocs: FilerReason := noMoreDocs 
000317 erAborted: FilerReason := aUserAbort; 
000318 OTHERW SE FilerReason := internal Error 
000319 END; 

000320 {$1 FC fTrace}EP; {$ENDC} 

000321 END; 

000322 

000323 


000324 {$8 SgABCi ni } 
000325 PROCEDURE InitProcess 


000326 CONST 

000327 maxNameLen = 63; {this definition must be consistent with the DeskTop Manager } 
000328 TYPE 

000329 TDeskLabel = RECORD {this definition must be consistent with the DeskTop Manager } 
000330 version: INTEGER; 

000331 name: STRING[ maxNameLen] 
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000332 
000333 
000334 
000335 
000336 
000337 
000338 
000339 
000340 
000341 
000342 
000343 
000344 
000345 
000346 
000347 
000348 
000349 
000350 
000351 
000352 
000353 
000354 
000355 
000356 
000357 
000358 
000359 
000360 
000361 
000362 
000363 
000364 
000365 
000366 
000367 
000368 
000369 
000370 
000371 
000372 
000373 
000374 
000375 
000376 
000377 
000378 
000379 


VAR 


BEGIN 
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(** other stuff we are not interested in 

kind: INTEGER; 

tool Only: BOOLEAN; 

mul ti Doc: BOOLEAN 

wi ndLoc: Rect; 
{plus there are other fields added for Spring release} 
xk 


END; 


TPPathName = “Pat hname 


copyright: $255; 
prcsinfo: Procl nf oRec 
progName: TFil ePath; 


error: INTEGER; 
toolLabel: TDeskLabel 
actual: LONGI NT; 
len: INTEGER; 


pPathName: TPPathname; 


{$1 FC fTrace}BP(1); {$ENDC} 


{Tool 


Kit Library copyright notice (application must 
copyright 


:= ‘Copyright 1983, 1984, Apple Computer, Inc.'; 


{Initialize Various Gl obals} 


idl eTi me 


sa 


inBackground := FALSE; 
{$1 FC fDbgABC} 
fCountHeap := FALSE; 
fExperimenting := FALSE; 
eventDebug := FALSE; {Don't trace window manager events} 


{$ENDC} 


activeWndowlD := 0; 
allowAbort := TRUE; 
boundDocument := NIL; 


boundCli pboard 
closedDocument : 
current Window := NIL; 


currentDocument := NIL; 
docList := NIL; 
cursorShape := noCursor 


{Assign process and tool globals} 
myProcess!D := my_id; 

Info Process(error, myProcessID, prcsinfo); 
IF error > 0 THEN 

InitErrorAbort(error); 


progName 


:= presinfo. progPat hName 


SplitFilePath(progName, tool Volume, tool Prefix); 


Apple Lisa ToolKit 3.0 Source Code Listing 


have its own notice in addition) } 


98 of 1012 


Apple Lisa Computer Technical Information 


000380 Get PrefixPart(progName, tool Prefix); (*' {Tnn}'*) 

000381 myTool := Tool Of File( progName) ; 

000382 

000383 {Read name of tool} 

000384 pPathName := @progName 

000385 Read Label(error, pPathName*, ORD(@toolLabel), SIZEOF(toolLabel), actual) 
000386 

000387 IF (error <= 0) AND (Length(toolLabel.name) > 0) AND (Length(toolLabel. name) <= maxNameLen) THEN 
000388 tool Name := toolLabel. name 

000389 ELSE 

000390 BEGIN 

000391 LI ntToStr(myTool, @tool Name); 

000392 tool Name := CONCAT('Tool ', tool Name) 

000393 END; 

000394 {$1 FC fTrace}EP; {$ENDC} 

000395 END; 

000396 

000397 


000398 {$8 SgABCcld} {Segmentation ???} 
000399 FUNCTION GetTime: LONGI NT; 
000400 BEGIN 


000401 {$1 FC fTrace}BP(1); {$ENDC} 

000402 Get Ti me := Ti me; 

000403 {$1 FC fTrace}EP; {$ENDC} 

000404 END; 

000405 

000406 

000407 METHODS OF TProcess 

000408 

000409 

000410 {$5 SgABCi ni } 

000411 FUNCTION {TProcess. }CREATE{(object: TObject; heap: THeap): TProcess}; 
000412 BEGIN 

000413 {$I1FC fTrace}BP(7); {$ENDC} 

000414 IF object = NIL THEN 

000415 object := NewObject(heap, THISCLASS) 
000416 SELF := TProcess(object); 

000417 {$I1FC fTrace}EP; {$ENDC} 

000418 END; 

000419 

000420 

000421 {$S sStartup} 

000422 FUNCTION {TProcess. }Abort Request {: BOOLEAN}; 
000423 BEGIN 

000424 {$IFC fTrace}BP( 2); {$ENDC} 

000425 IF all owAbort THEN 

000426 AbortRequest := Abort {ask Wndow Manager} 
000427 ELSE 
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AbortRequest := FALSE; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$8 SgABCcl d} 


If allowAbort is FALSE, simply calls fs.XferSequenti al 
Otherwise, transfers in increments of chunksize and sets fs. Error to erAborted IF command period 
is pressed during the transfer. Returns with an incomplete transfer IF command period or any other 
error occurs during the transfer. } 
PROCEDURE {TProcess. }AbortXferSequential {(whichWay: xReadWrite; pFirst: Ptr; 
numBytes, chunksize: LONGINT; fs: TFileScanner) }; 
VAR xferAmount: LONGI NT 
actual: LONGI NT; 
BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
1F allowAbort THEN 
BEGIN 
actual := 0; 


WHILE (numBytes > 0) AND (fs.error <= 0) AND 
NOT (fs.atEnd AND (whichWay = xRead)) DO 


BEGIN 
1F numbytes > chunksize THEN 
xferAmount := chunksize 
ELSE 
xferAmount := numbytes 
IF process. AbortRequest THEN 
fs.error := erAborted 
ELSE 
BEGIN 
fs. XferSequential (whichWay, pFirst, xferAmount) 
xferAmount := fs.actual 


{$l FC f DbgABC} 
IF (xferAmount <= 0) AND (fs.error <= 0) THEN 

ABCbreak('In TProcess.AbortXferSequential, fs.actual <= 0', xferAmount); 
{$ENDC} 


actual := actual + xferAmount; 
numbytes := numBytes - xferAmount; 
pFirst := POINTER(ORD( pFirst) + xferAmount); 
END; 
END; 


fs.actual := actual; {make believe we xferred it all at once} 
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END 
ELSE 
fs. XferSequential (whichWay, pFirst, numBytes); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sAlert} 
PROCEDURE {TProcess. }ArgAlert{(whichArg: TArgAlert; argText: $255) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
ArgAlert(whichArg, argText); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ sAlert} 
FUNCTION {TProcess. }Ask{(phraseNumber: INTEGER): INTEGER}; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
ArgAlert(0, tool Name) 
{$1FC LibraryVersion > 20} 
1F activeWindowl D = 0 THEN 
Ask := BackgroundAlert(alerts, phraseNumber, AskProc) 
ELSE 
{$ENDC} 
Ask := AskAlert(alerts, phraseNumber) ; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ sAlert} 
PROCEDURE {TProcess. }Begi nWait{(phraseNumber: INTEGER) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
ArgAlert(0, tool Name) 
WaitAlert(alerts, phraseNumber); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TProcess. }Bi ndCurrent Document; 
BEGIN 
{$1FC fTrace}BP(6); {$ENDC} 
IF (boundDocument <> currentDocument) AND (boundDocument <> NIL) THEN 
boundDocument. Unbi nd; 
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IF (boundClipboard <> currentDocument) AND (boundClipboard <> NIL) THEN 
boundCli pboard. Unbi nd 


IF currentDocument <> NIL THEN 
current Document. Bi nd 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ sAlert} 
FUNCTION {TProcess. }Caution{(phraseNumber: INTEGER): BOOLEAN}; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
ArgAlert(0, tool Name) 
{$1FC LibraryVersion > 20} 
IF activeWindowlD = 0 THEN 
Caution := (BackgroundAlert(alerts, phraseNumber, CautionProc) = ORD(TRUE)) 
ELSE 
{$ENDC} 
Caution := CautionAlert(alerts, phraseNumber); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TProcess. }ChangeCursor{(cursorNumber: TCursorNumber) }; 
BEGIN 
{$IFC fTrace}BP( 4); {$ENDC} 
1F cursorNumber <> cursorShape THEN 
BEGIN 
SELF. DoCursorChange( cursor Number ) 
cursorShape := cursorNumber 
END; 


1F cursorNumber > icrsLast THEN 
Set StdCursor(icrsEscape); 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$S SgABCi ni } 
PROCEDURE {TProcess. }Commence{(phraseVersion: INTEGER) }; 
VAR aFile: TFile; 
cacheSize: INTEGER 
cacheBytes: INTEGER; 
i: INTEGER; 
oneChar: STRING[ 1]; 
manual Pat: Pattern; 


Apple Lisa ToolKit 3.0 Source Code Listing -- 102 of 


1012 


000572 
000573 
000574 
000575 
000576 
000577 
000578 
000579 
000580 
000581 
000582 
000583 
000584 
000585 
000586 
000587 
000588 
000589 
000590 
000591 
000592 
000593 
000594 
000595 
000596 
000597 
000598 
000599 
000600 
000601 
000602 
000603 
000604 
000605 
000606 
000607 
000608 
000609 
000610 
000611 
000612 
000613 
000614 
000615 
000616 
000617 
000618 
000619 


Apple Lisa Computer Technical Information 


error: | NTEGER; 
prPrfAlias: TPrPrfAlias 
str: $255; 


convResult: TConvResult; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 


{Open Phrase File} 

aFile := TFile. CREATE(NIL, mainHeap, CONCAT(tool Volume, tool Prefix, 'PHRASE'), '') 
phraseFile := aFile.ScannerFrom(0, [fRead]); 

[nitErrorAbort(phraseFile.error); 


{Read Menus} 
menuBar := TMenuBar.CREATE(NIL, mainHeap, phraseFile); 


{Initialize and Read Alerts} 

cacheSize := phraseFile. ReadNumber (2); 

cacheBytes := phraseFile. ReadNumber (2); 

[nitErrorAbort(phraseFile.error); 

InitAlerts(cacheSize, cacheBytes, POINTER(ORD( mainHeap)), NIL, @AlErrProc); 
InitErrorAbort(alertError); 

alerts := ReadAlerts(phraseFile.refnum, phraseVersi on) 
InitErrorAbort(alertError); 


{Read Word Deli miters} 
GetAlert(alerts, phWordDelimiters, @wordDelimiters) 
IF Length(wordDelimiters) > 67 THEN 
BEGIN 
ABCBreak('More than 67 characters in the word delimiter string--phrase number’, phWordDeli miters); 
{ Set error to something so we don't continue } 
InitErrorAbort(erlnternal); 
END; 


{Read "OK" and "Cancel "} 

Get Butn(0, @cancel String); 
StrUpperCased( @cancel String); 
GetButn(1, @okString); 
StrUpperCased( @okStri ng); 


GetAlert(alerts, phNewHeading, @dfltNewHeading); {+SW+} 
GetAlert(alerts, phPage, @varPage); {+SW+} 
GetAlert(alerts, phTitle, @varTitle); {+SW+} 


GetAlert(alerts, phCountry, @str); 

StrTolnt(@str, countryCode, convResult); 

1F convResult <> cvValid THEN 
countryCode := 0; 
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{Create a handle to use in picture comments} 


picData 


{Read Tool 


Name } 


GetAlert(alerts, 


BEGI 


:= HAllocate( THz(mainHeap), 


1); 


phTool Name, @tool Name); 
IF Length(tool Name) > 67 THEN 


ABCBreak('More than 67 characters in the tool 
InitErrorAbort(erl nternal); 


END; 


{Read Tool 


1F onDesktop THEN 
BEGIN 


{Initialize Print Manager, while Alert Segment is still 
{$1 FC LibraryVersion <= 20} 


Name from file label 


PrMgrinit(error); 
InitErrorAbort(error); 


{$ELSEC} 


{$ENDC} 


PrMgri nit; 


{Initialize Scrol 

| nit Wml Sb; 

Init Wml Crs(error); 
InitErrorAbort(error); 


{$1FC LibraryVersion <= 20 


{$ENDC} 


{Create fonts} 
fonts[ 0] := TFont 
fonts[ 1] := TFont 
fonts[ 2] := TFont 
fonts[ 3] := TFont 
fonts[ 4] := TFont 
fonts[ 5] := TFont 
fonts[ 6] := TFont 
fonts[ 7] := TFont 
fonts[ 8] := TFont 
fonts[ 9] := TFont 
fonts[10] := TFont. 
fonts[11] := TFont. 


AND FALSE} {do it this way in case we need it back for the Pepsi version} 


CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 
CREATE(NIL, 


{Specify suspend-file suffixes} 


oneChar 


'Q': 


is done in InitProcess} 


Bar and Cursor Library} 


mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
mai nHeap, 
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sysText); 
pl5Tile); 
pl2tile); 
elite); 

pl0tile) 
pl0cent ) 
tile12 ) 
cent1l2 ) 
tile18 ) 
cent18 ) 
tile24 ) 
cent24 ) 


Resi dent } 


{System Font } 
{15 pitch Gothic } 
{12 pitch Modern } 
{12 pitch Elite } 
{10 pitch Modern } 
{10 pitch Courier} 
{PS Modern } 
{PS Executive } 
{1/4 inch Modern } 
{1/4 inch Classic} 
{1/3 inch Modern } 
{1/3 inch Classic} 
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FOR i := 1 TO maxSegments DO 
BEGIN 
oneChar[1] := CHR( 48+i) 


{Initialize other globals} 


SetPt(zeroPt, 0, 0); 
SetRect(zeroRect, 0, 0, 0, 0); 
SetRect(hugeRect, 0 


SetLPt(zeroLPt, 0, 0) 
SetLRect(zeroLRect, 0, 0, 0, 0); 
SetLRect(hugeLRect, 0 


orthogonal[v] : 
orthogonal[h] := v; 


, 0, $3FFFFFFF, 


suspendSuffix[i] := CONCAT('$S', oneChar) 
E ' 


, 0, $3FFF, $3FFF) 


$3FFFFFFF); 


doclList := TList.CREATE(NIL, mainHeap, 1); 


hi ghToggle[ FALSE] := hOnToOff; 
hi ghToggl e[ TRUE] = hOffToOn; 
hi ghLevel [FALSE] := hOffToDim 
hi ghLevel [ TRUE] = hOffToOn; 


PenNor mal 
Get PenState( normal Pen); 


PenSize(2, 2); 


PenMode( pat Xor); 

PenPat (gray); 

Get PenState(highPen[ hDi mToOff]); 
Get PenState(highPen[ hOffToDi mJ); 


PenMode(notPatXor); 

PenPat (gray); 

Get PenState(highPen[ hOnToDi m] ); 
Get PenState(highPen[ hDi mToOn]); 


PenMode( pat Xor); 

PenPat (bl ack); 

Get PenState(highPen[ hOffToOn]); 
Get PenState(highPen[ hOnToOff]); 


PenSize(3, 2); 
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000716 PenMode( pat XOr) 

000717 

000718 PenPat (gray); 

000719 Get PenState( aut oBreakPen) 

000720 

000721 Stuf fHex( @manual Pat, 'CC663399CC663399' ) 

000722 PenPat( manual Pat); 

000723 Get PenState( manual BreakPen) 

000724 

000725 Stuff Hex(@marginPattern, '8000000008000000'); 

000726 

000727 PenNor mal 

000728 PenPat( manual Pat); 

000729 Get PenState(1|imboPen) 

000730 

000731 SetPt(screenRes, 90, 60); {Lisa 1.0 screen} {better--get from phrase file} 
000732 screenRightEdge := 720; {redundant -- screenBits. bounds. right shd be the same} 
000733 

000734 SetLRect(stdMargins, screenRes.h, screenRes.v, - screenRes.h, -screenRes. v) 
000735 

000736 PenNor mal 

000737 

000738 noPad := TPad.CREATE(NIL, mainHeap, zeroRect, hugeLRect, screenRes, screenRes, NIL) 
000739 

000740 (***** Do this in TPad creation block, via coercion 

000741 noPad. PatToLPat( white, | Pat White) 

000742 noPad. PatToLPat( black, | Pat Bl ack) 

000743 noPad. PatToLPat (gray, | PatGray) 

000744 noPad, PatToLPat(|ItGray, | PatLtGray) 

000745 noPad, PatToLPat(dkGray, | PatDkGray) 

000746 *****) 

000747 

000748 MakeTypeStyle(famClassic, sizel8Point, [], cornerNumberStyle); 
000749 

000750 theMarginPad := TMarginPad. CREATE( NIL, mai nHeap) 

000751 theBodyPad := theMarginPad. bodyPad 

000752 IF crashPad = NIL THEN 

000753 crashPad := theMarginPad 

000754 

000755 clipboard := TClipboard. CREATE(NIL, mai nHeap); 

000756 

000757 padRgn := NewRgn; 

000758 focusRgn := thePort*. visRgn; 

000759 focusStkPtr := 0: 

000760 focusArea := NIL; 

000761 genClipPic := FALSE; 

000762 amPrinting := FALSE; 

000763 useAltVisRgn := FALSE; 
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000764 
000765 
000766 
000767 
000768 
000769 
000770 
000771 
000772 
000773 
000774 
000775 
000776 
000777 
000778 
000779 
000780 
000781 
000782 
000783 
000784 
000785 
000786 
000787 
000788 
000789 
000790 
000791 
000792 
000793 
000794 
000795 
000796 
000797 
000798 
000799 
000800 
000801 
000802 
000803 
000804 
000805 
000806 
000807 
000808 
000809 
000810 
000811 


END; 


{$$ 
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altVisRgn := NewRgn; 

scroll Rgn := NewRgn; 
scrRgniForDrawHdgs := NewRgn; 
scrRgn2ForDrawHdgs := NewRgn; 
blinkOnCentiSecs := caret OnTi me 


blinkOffCentiSecs := caretOffTi me; 


PrPrfDefault(prPrfAlias. prPrf); 
clipPrintPref := prPrfAlias. reserve 


{ Final check for Abort in init } 
InitErrorAbort(0); 


{$1FC fTrace}EP; {$ENDC} 


SgABCi ni } 
PROCEDURE {TProcess. }Complete{(all!sWell: BOOLEAN) }; 
VAR s: TListScanner: 
document: TDocManager 
N 


BEGI 


{$I1FC fTrace}BP(7); {$ENDC} 

1F NOT (alllsWell OR amDying) THEN 
BEGIN 
ImDying; {Do this first} 


IF (boundClipboard <> NIL) AND (scrapProcess = myProcess) THEN {*** 


BackOut Of Scrap; 
amDying := TRUE; 
END; 


{$1FC f DbgABC} 
1F NOT alll sWell THEN 
ABCBreak('Process. Compl ete(FALSE)', 0); 


{$ENDC} 

IF doclList <> NIL THEN 
BEGIN 
s := docList. Scanner 


docList := NIL; 
WHILE s.Scan(document) DO 
document. Compl ete(alllsWell); 
END; 
HALT; 
{$I1FC fTrace}EP; {$ENDC} 
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000812 
000813 
000814 
000815 
000816 
000817 
000818 
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000829 
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000832 
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000835 
000836 
000837 
000838 
000839 
000840 
000841 
000842 
000843 
000844 
000845 
000846 
000847 
000848 
000849 
000850 
000851 
000852 
000853 
000854 
000855 
000856 
000857 
000858 
000859 
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END; 


{$S SgABCcl d} 
PROCEDURE {TProcess. }CopyExternal Doc(VAR error: INTEGER; external Name, volumePrefix: TFilePath) 
BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
{$1 FC fDbgABC} 
ABCbreak('TProcess. CopyExternal Doc was not overridden’, 0); 
{$ENDC} 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ sAlert} 
PROCEDURE {TProcess. }CountAlert{(whichCtr: TAlertCounter; counter: INTEGER) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
CountAlert(whichCtr, counter); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sStartup} 
PROCEDURE {TProcess. }DoCursorChange{(cursorNumber: TCursorNumber) }; 
BEGIN 
{$I FC fTrace}BP( 4); {$ENDC} 
Set StdCursor(cursorNumber): 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$8 SgABCi ni } 
PROCEDURE {TProcess. }Dont Debug 
BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
f Checkl ndices := FALSE: 
{$l FC f DbgABC} 
event Debug := FALSE; 
fCountHeap := FALSE; 
fExperi menting := FALSE; 
{$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$ENDC} 
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000860 {$$ sAlert} 

000861 PROCEDURE {TProcess. }DrawAlert(phraseNumber: INTEGER; marginLRect: LRect) 
000862 VAR recti nWi ndow: Rect; 

000863 BEGIN 

000864 {$I1FC fTrace}BP(7); {$ENDC} 

000865 ArgAlert(0, tool Name) 

000866 thePad, LRectToRect(marginLRect, rectIl nWindow); 

000867 DrawAlert(alerts, phraseNumber, rect! nWindow); 

000868 {$1FC fTrace}EP; {$ENDC} 

000869 END: 

000870 

000871 

000872 {$1 FC fDbgABC} 

000873 {$S SgABCdbg} 

000874 PROCEDURE {TProcess. }DumpGl obals; 

000875 VAR str: $8; 

000876 PROCEDURE AbortDumpVar(pVariable: Ptr; nameAndType: $255) 
000877 BEGIN 

000878 1F CheckKeyPress('Process global variable dump’) THEN 
000879 BEGIN 

000880 WriteLn; 

000881 WriteLn; 

000882 Exit(DumpGl obals); 

000883 END; 

000884 DumpVar(pVariable, nameAndType) 

000885 END; 

000886 BEGIN 

000887 WriteLn; 

000888 WriteLn('--- | MPORTANT GLOBAL VARIABLES OF THE PROCESS ---') 
000889 WriteLn; 

000890 Abort DumpVar(@activeWindowlD, ‘activeWndowlD: Ptr'); 

000891 Abort DumpVar(@allowAbort, ‘all owAbort: BOOLEAN’ ) 

000892 Abort DumpVar( @boundClipboard, 'boundClipboard: TClipboard') 
000893 Abort DumpVar( @boundDocument, 'boundDocument: TDocManager' ); 
000894 Abort DumpVar(@clickState, Concat('clickState: RECORD where: Point; when: LONGI NT;' 
000895 ‘clickCount: INTEGER; fShift: BOOLEAN; fOption: BOOLEAN; fApple: BOOLEAN END')); 
000896 Abort DumpVar(@clipboard, ‘clipboard: TClipboard'); 

000897 Abort DumpVar( @cl osedBySuspend, ‘closedBySuspend: BOOLEAN' ); 
000898 Abort DumpVar(@closedDocument, ‘closedDocument: TDocManager' ) 
000899 Abort DumpVar(@current Document, ‘currentDocument: TDocManager' ) 
000900 Abort DumpVar( @current Window, ‘current Window: TWi ndow' ) 
000901 Abort DumpVar(@cursorShape, ‘cursorShape: I NTEGER'); 

000902 Abort DumpVar(@deferUpdate, ‘deferUpdate: BOOLEAN’); 

000903 Abort DumpVar(@docList, ‘docList: TList') 

000904 Abort DumpVar(@genClipPic, ‘genClipPic: BOOLEAN' ) 

000905 Abort DumpVar(@idleTime, ‘idleTime: LONGINT'); 

000906 Abort DumpVar(@inBackground, ‘inBackground: BOOLEAN' ); 

000907 Abort DumpVar(@menuBar, '‘menuBar: TMenuBar'); 
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000908 
000909 
000910 
000911 
000912 
000913 
000914 
000915 
000916 
000917 
000918 
000919 
000920 
000921 
000922 
000923 
000924 
000925 
000926 
000927 
000928 
000929 
000930 
000931 
000932 
000933 
000934 
000935 
000936 
000937 
000938 
000939 
000940 
000941 
000942 
000943 
000944 
000945 
000946 
000947 
000948 
000949 
000950 
000951 
000952 
000953 
000954 
000955 
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Abort DumpVar( @myProcessID, 'myProcessID: LONGINT'); 
Abort DumpVar(@myTool, ‘myTool: LONGINT'); 
AbortDumpVar(@process, ‘process: TProcess'); 
Abort DumpVar(@tool Name, ‘toolName: STRING[67]'); 
Abort DumpVar( @tool Prefix, ‘tool Prefix: STRING[255]'); 
Abort DumpVar( @tool Volume, ‘tool Volume: STRING[255]'); 
WriteLn; 
WriteLn; 

END; 

{$ENDC} 


{$$ sAlert} 
PROCEDURE {TProcess. }EndWait; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
{$1FC LibraryVersion <= 20} 
Hi deFol der(alertFol der); 
{$ELSEC} 
EndWaitAlert; 
{$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sAlert} 
PROCEDURE {TProcess. }GetAlert{(phraseNumber: INTEGER; VAR theText: $255) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
GetAlert(alerts, phraseNumber , @theText); 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ Override} 


FUNCTION {TProcess. }NewDocManager{(volumePrefix: TFilePath; openAsTool: BOOLEAN): 


BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
NewDocManager := TDocManager.CREATE(NIL, mainHeap, vol umePrefi x) 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ sAlert} 
PROCEDURE {TProcess. }Note{(phraseNumber: INTEGER) }; 
{$1 FC LibraryVersion > 20} 
VAR dummy: | NTEGER; 
{$ENDC} 
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000956 
000957 
000958 
000959 
000960 
000961 
000962 
000963 
000964 
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000972 
000973 
000974 
000975 
000976 
000977 
000978 
000979 
000980 
000981 
000982 
000983 
000984 
000985 
000986 
000987 
000988 
000989 
000990 
000991 
000992 
000993 
000994 
000995 
000996 
000997 
000998 
000999 
001000 
001001 
001002 
001003 
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BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
ArgAlert(0, tool Name) 
{$1FC LibraryVersion > 20} 
[F activeWindowl D = 0 THEN 
dummy := BackgroundAlert(alerts, phraseNumber, NoteProc) 
ELSE 
{$ENDC} 
NoteAlert(alerts, phraseNumber) ; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{ NOTE: StopCondition is checked only when no events are available. 
NOTE: StopCondition should not assume that a document is bound. If all the process' windows are 
inactive, StopCondition will be called before the process is suspended (to give you 
a chance to regain control), but all the process’ documents will be unbound. You can 
check for this situation by testing currentDocument for NIL. } 


{$S sStartup} 

PROCEDURE {TProcess. }ObeyEvents{( FUNCTION StopCondition: BOOLEAN) }; 
LABEL 9; 
VAR selection: TSelection; 


PROCEDURE StopTest; 


BEGIN 
IF StopCondition THEN 
BEGIN 
Let Ot hers Run; 
GOTO 9: 
END; 
END; 
PROCEDURE Get AndObeyEvent; 
LABEL 1; 
BEGIN 


{$1FC fTrace}BP(1); {$ENDC} 
Get Event(event); 


{$1 FC fDbgABC} 
[F fExperimenting and event Debug THEN 
WITH event. who*. portRect DO 

BEGIN 
WriteLn('GetAndObeyEvent (event.who):', ORD( event. who) ); 
WriteLn(left, top, right, bottom); 
WriteLn(event.where.h, event. where. v); 
END; 
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001004 {$ENDC} 

001005 

001006 1F | mActive THEN 

001007 1F SELF. AbortRequest THEN 

001008 IF event. what IN [keyDown, buttonDown, buttonUp] THEN 
001009 GOTO 1; 

001010 SELF. ObeyTheEvent; 

001011 1: 

001012 {$1 FC fTrace}EP; {$ENDC} 

001013 END; 

001014 

001015 BEGIN 

001016 {$I1FC fTrace}BP(7); {$ENDC} 

001017 {Shouldn't tell Filer initFailed after this} 

001018 istnitialized := TRUE; 

001019 

001020 {Main event loop} 

001021 

001022 {NOTE: currentWndow <> NIL implies (1) process is active OR 
001023 (2) process is running in the background and has a document } 
001024 

001025 REPEAT 

001026 WHILE NOT (I mActive OR amDying OR (currentWindow <> NIL)) DO 
001027 BEGIN 

001028 1F NOT EventAvail THEN 

001029 StopTest; 

001030 GetAndObeyEvent; {may suspend me} 

001031 END; 

001032 

001033 WHILE (I mActive OR (currentWndow <> NIL)) AND NOT amDying DO 
001034 IF EventAvail THEN 

001035 Get AndObeyEvent 

001036 ELSE 

001037 BEGIN 

001038 StopTest; 

001039 

001040 current Window. Update( TRUE); 

001041 1F current Window. dialogBox <> NIL THEN 

001042 current Window. dial ogBox. Updat e( TRUE) 

001043 

001044 IF NOT (amDying OR eventAvail) THEN 

001045 BEGIN 

001046 selection := current Window. sel ect Window, sel ectPanel.sel ection; 
001047 idleTime := Time; 

001048 selection. !dleBegin(idl eTi me); 

001049 WHILE NOT (amDying OR eventAvail) DO 

001050 selection. |! dl eConti nue( Ti me) 

001051 1F NOT amDying THEN 
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001052 
001053 
001054 
001055 
001056 
001057 
001058 
001059 
001060 
001061 
001062 
001063 
001064 
001065 
001066 
001067 
001068 
001069 
001070 
001071 
001072 
001073 
001074 
001075 
001076 
001077 
001078 
001079 
001080 
001081 
001082 
001083 
001084 
001085 
001086 
001087 
001088 
001089 
001090 
001091 
001092 
001093 
001094 
001095 
001096 
001097 
001098 
001099 


END; 


UNTIL amDyi ng; 


9: 
{$I FC fTrace}EP; {$E 
END; 


{$S sStartup} 
PROCEDURE {TProcess 
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selection. | dl eEnd( Ti me); 
END: 


NDC} 


. }ObeyFilerEvent; 


LABEL 1; 
TYPE 
{$1FC LibraryVersion <= 20} 
TFileOpKind = (fopNone, fopSuspend, fopSaveVersi on); 
{$ELSEC} 
TFileOpKind = (fopNone, fopSuspend, fopSaveVersion, fopCopyDoc); 
{$ENDC} 
VAR reply: FRepl y; 
badRepl y: FRepl y; 
reason: FReason; 
wi ndow: TWi ndow 
openAsTool: BOOLEAN 
document: TDocManager; 
flrParams: FilerExt; 
flr Op: FilerOp; 
vol umePrefix: TFilePath; 
was Suspended: BOOLEAN; 
fil eOpKi nd: TFil eOpKi nd 
doSuspend: BOOLEAN 
doSave: BOOLEAN; 
error: INTEGER; 
PROCEDURE CheckAbort(abortReason: INTEGER); 
VAR i: INTEGER; 
dsPathname: PathName 
BEGIN 
IF abortReason = 0 THEN 
|F SELF. AbortRequest THEN 
abortReason := erAborted 
ELSE 


Exit(CheckAbort); 


{$1 FC fDbgABC} 
IF abortReason <> erAborted THEN 
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001100 
001101 
001102 
001103 
001104 
001105 
001106 
001107 
001108 
001109 
001110 
001111 
001112 
001113 
001114 
001115 
001116 
001117 
001118 
001119 
001120 
001121 
001122 
001123 
001124 
001125 
001126 
001127 
001128 
001129 
001130 
001131 
001132 
001133 
001134 
001135 
001136 
001137 
001138 
001139 
001140 
001141 
001142 
001143 
001144 
001145 
001146 
001147 
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BEGIN 
WriteLn(' aie wisu acai ay Wier ease biee date alsa ail '); 
ReportFilerEvent(flrParams); 
ABCbreak('TProcess. ObeyFilerEvent got an error (event listed above)', abortReason); 
END; 
{$ENDC} 


IF (flrOp = fcResume) OR (flrOp = fcNone) THEN 
BEGIN 
1F window <> NIL THEN 
PopFocus; 
|F wasSuspended THEN 
{ Close but don't kill the datasegs } 


BEGIN 
FOR i := 1 TO maxSegments DO 
IF document. dataSegment.refnum[i] >= 0 THEN 

BEGIN 
dsPathName := Concat(document.files.volumePrefix, suspendSuffix[i]); 
Close DataSeg(error, document. dataSegment.refnum[i]); 
document.dataSegment.refnum[i] := -1; 
END 

END 

ELSE 
BEGIN 


{ In case the BlankStationery method was called and opened any files } 
document. CloseFiles; 
{ kill any data segments that were created } 
document. Kill Segments(1, maxSegments); 
END; 
{ delete from docList, IF there, and free regardless } 
docList. Del Obj ect(document, TRUE); 


boundDocument := NIL; 
END; 
Tell Filer(error, badReply, FilerReason(abortReason), event. who); 
GOTO 1; 
END; 
BEGIN 


{$IFC fTrace}BP(7); {$ENDC} 
wasSuspended := FALSE; 
GetAddParams(error, event, flrParams); 
IF error > 0 THEN 
ABCBreak('GetAddParams', error); 
flrOp := flrParams.theFl r Op; 
allowAbort := TRUE; {??? should we assume this ???} 


{$1 FC fDbgABC} 
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|F eventDebug THEN 
ReportFilerEvent(flrParams); 
{$ENDC} 


CASE flrOp OF 
fcNone, fcResume: 
BEGIN 
{ The assumption for aborting here is things will, where possible, be cleaned up along the way 
by anyone detecting the abort. Things that have already happened after the abort is 
detected will be cleaned up in CheckAbort. The process will of course continue after the 
abort. } 


IF (inBackground) AND (doclist.size > 0) THEN 
Tell Filer(error, docClosd, noMoreDocs, event. who) {No multiple doc's in background} 


ELSE 
BEGIN 
{ Set badReply in case Abort is detected } 
badReply := docClosd 


TakeWi ndow( event. who) 


WTH flrParams DO 
BEGIN 
openAsTool := flrOp = fcNone 


1F openAsTool THEN 
thePrefix := CONCAT(tool Volume, tool Prefix) 


document := SELF, NewDocManager(thePrefix, openAsTool); 
{$1FC LibraryVersion > 20} 

document.files. password := thePassword 

{$ENDC} 

END; 


1F document = NIL THEN {application refused the request} 
Tell Filer(error, docClosd, noMoreDocs, event. who) 


ELSE 
BEGIN 
document. openedAsTool := openAsTool 


SetPort(event. who); {so things like InvalRect in BlankStationery will work} 
{ Returns Abort as error = erAborted } 
document. Open(error, ORD( event. who), wasSuspended) 


window := NIL; {so CheckAbort will not PopFocus} 
CheckAbort(error); 
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001196 

001197 PushFocus: 

001198 window := document. window 

001199 wi ndow. Focus 

001200 wi ndow. Resi ze( FALSE) 

001201 CheckAbort(0); 

001202 

001203 Inval Rect(window.innerRect); 

001204 wi ndow. Updat e( TRUE) 

001205 CheckAbort(0); 

001206 PopFocus; 

001207 

001208 IF event. who = activeFolder THEN {already active so we don't get a folderActivate} 
001209 BEGIN 

001210 PushFocus: 

001211 window. Focus; {window. Activate assumes focused} 
001212 current Document := document; {this must be set before calling TWindow. Acti vate} 
001213 wi ndow. Activate; 

001214 PopFocus; 

001215 END 

001216 ELSE 

001217 wi ndow. StashPicture(hOffToDim; 

001218 END; 

001219 END; 

001220 END; {fcNone/fcResume case} 

001221 

001222 { The assumption for aborting here is things will be cleaned up along the way by anyone 
001223 detecting the abort. The process will of course continue after the abort. } 
001224 fcClose, fcSuspend, fcCopy, fcPut, fcShred 

001225 BEGIN 

001226 {$IFC LibraryVersion <= 20} 

001227 fileOpKind := fopNone 

001228 document := POI NTER( Get Fl drRefCon( event. who) ) 

001229 document. Bind 

001230 {$ELSEC} 

001231 IF (flrOp = fcCopy) AND (Length(flrParams.theResult) > 0) THEN 
001232 BEGIN 

001233 fileOpKind := fopCopyDoc 

001234 document := NIL: 

001235 END 

001236 ELSE 

001237 BEGIN 

001238 fileOpKind := fopNone 

001239 document := POINTER(GetFldrRefCon( event. who) ); 

001240 document. Bind 

001241 END; 

001242 


001243 {$ENDC} 
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CASE flrOp OF 
fcClose, fcSuspend, fcShred: 
BEGIN 
IF flrOp = fcClose THEN 
BEGIN 
1F document. window. changes <> 0 THEN 
fileOpKind := fopSaveVersi on; 
END 
ELSE 
fileOpKind := fopSuspend; 


volumePrefix := document. files. vol umePrefix: 
reply := docClosd; 
badReply := docNotClosd 


END; 
OTHERWISE {fcCopy, fcPut} 
BEGIN 
{$1FC LibraryVersion <= 20} 
fileOpKind := fopSaveVersi on; 
{$ELSEC} 
IF fileOpKind <> fopCopyDoc THEN 
fileOpKind := fopSaveVersi on; 
{$ENDC} 
volumePrefix := flrParams.thePrefi x; 
reply := docXfered; 
badReply := docNotXfered 
END; 
END; 
allowAbort := NOT doSuspend; {for now all ops can be aborted except fcSuspend and fcShred} 


CheckAbort(0); 


IF document <> NIL THEN 
document. ConserveMemory(0, TRUE {GC}); 


CheckAbort(0); 
CASE fileOpKind OF 
f opSuspend: 
IF document.files.shouldSuspend THEN 
document. Suspend(error); {*** we ignore the volumePrefix !!! ***} 


f opSaveVersi on: 
IF document.files.shouldToolSave OR NOT document. openedAsTool THEN 
document. SaveVersion(error, volumePrefix, FALSE); 


{$1FC LibraryVersion > 20} 
f opCopyDoc: 
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SELF. CopyExternal Doc(error, flrParams.theResult, volumePrefix) 
{$ENDC} 
END; 


{ You cannot abort after SaveVersion or Suspend unless the abort was detected within 
SaveVersion or Suspend and indicated by their returned error being erAborted } 


1F error > 0 THEN 

IF flrOp = fcShred THEN 
BEGIN {try to close all files} 
document. CloseFiles 
document. Kill Segments(1, maxSegments); 
error := 0; {always give a good reply to the filer} 
END 

ELSE 
CheckAbort(error); 


Tell Filer(error, reply, FilerReason(error), event. who); 


1F flrOp <> fcCopy THEN 


BEGIN 
closedDocument := document 
closedBySuspend := doSuspend 
END; 

all owAbort := TRUE; 

END; 

fcDfClose 
BEGIN 


badReply := dfNotClosed 

Close Object(error, flrParams.theDf); 
CheckAbort(error); 

TellFiler(error, dfClosed, allOk, event. who); 
END; 


fcTermi nate: 
amDying := TRUE; 
END; 


1: {$l1FC fTrace}EP; {$ENDC} 


{$S sStartup} 
PROCEDURE {TProcess. }ObeyTheEvent; 
{NOTE: For the duration of the event, we are focused on the event Wi ndow} 
VAR eventDocument: TDocManager 
event Wi ndow: TWi ndow; 
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di al ogBox: TDi al ogBox; 

paused: BOOLEAN 

pkEvent: Event Record 
{$I1FC fCheckHeap} 

numObj ects: INTEGER 

docHeap: THeap; 
{$ENDC} 


FUNCTION EvtWndow( VAR evt: EventRecord): TWindow 
BEGIN 
{$1 FC fTrace}BP(1); {$ENDC} 
Evt Wndow := event Document. W ndowW thi d(ORD( evt. who) ) 
IF evt. what = keyDown THEN 
BEGIN 
dialogBox := current Window. dial ogBox 
IF dialogBox <> NIL THEN 
1F dialogBox.keyResponse = diDismissDialogBox THEN 
di alogBox. BeDi smi ssed 
ELSE 
{+SW+} IF (dialogBox.keyResponse = diAccept) AND (current Window. select Window = dial ogBox) 
Evt Window := dial ogBox 


END; 
{$I FC fTrace}EP; {$ENDC} 


END 

BEGIN 
{$1 FC fTrace}BP(7); {$ENDC} 
eventTime := event. when; 


eventType := event. what; 
{$1 FC fDbgABC} 
IF eventDebug THEN 
ReportEvent; 
{$ENDC} 
WITH event DO 
1F what = buttonUp THEN 
ELSE 
1F what = filerEvent THEN 
SELF. ObeyFilerEvent 
ELSE 
I1F who <> alertFolder THEN 
BEGIN 


1F what = folderActivate THEN 
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TakeControl(event, FALSE, FALSE); 
event Document := currentDocument; 


1F who = menuFolder THEN {much changed} 
BEGIN 
event Window := current Window; 
dialogBox := current Window. dial ogBox; 
IF dialogBox <> NIL THEN 


1F dialogBox. menuResponse = diDismissDialogBox THEN 


dial ogBox. BeDi smi ssed 
ELSE 
1F dialogBox. menuResponse = diAccept THEN 


event Window := current Window. select Window 


END 
ELSE 
1F who = dialogFolder THEN 
event Window := current Window. di al ogBox 
ELSE 
1F who = scrapFolder THEN 
BEGIN 
event Document := clipboard 
clipboard. Bind; 
event Window := clipboard. window 
END 


ELSE IF who = NIL THEN {assuming that we cannot receive a private event directed 


towards a particular window} 


BEGIN 
event Window := NIL; 


process. HandlePrivateEvent(what, fromProcess, when, 


END 
ELSE 
BEGIN 
event Document := POI NTER( Get Fl drRefCon( who)); 
1F eventDocument = NIL THEN 
BEGIN 
ABCBreak('GetFldrRefCon = NIL', ORD(who)); 
event Window := NIL; 
END 
ELSE 
BEGIN 
event Document. Bind; 
event Window := EvtWindow( event); 
END; 
END; 


IF event Window <> NIL THEN 
BEGIN 
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PushFocus; 
1F who = menuFolder THEN 


event Window. Focus 


BEGIN 

Set Port(event. who); 

{$1 FC fDbgABC} 

|F fExperimenting and event Debug THEN 

WITH thePort*. portRect DO 

BEGIN 
WriteLn('Before Local ToGlobal (thePort):', ORD(thePort)); 
WriteLn(left, top, right, bottom); 
WriteLn(where.h, where.v); 
END; 

{$ENDC} 


Local ToGI obal ( where); 
event Window. Focus 


{$1 FC fDbgABC} 
[F fExperimenting and event Debug THEN 
WITH thePort*. portRect DO 

BEGIN 
WriteLn('Before Global ToLocal (thePort):', ORD(thePort)); 
WriteLn(left, top, right, bottom); 
WriteLn(where.h, where.v); 
END; 

{$ENDC} 


Gl obal ToLocal ( where); 


{$1 FC fDbgABC} 
[F fExperimenting and event Debug THEN 
WITH thePort*. portRect DO 

BEGIN 
WriteLn('After Global ToLocal (thePort):', ORD(thePort)); 
WriteLn(left, top, right, bottom); 
WriteLn(where.h, where.v); 
END; 

{$ENDC} 

END; 


1F deferUpdate THEN 


1F (what <> keyDown) OR appleKey THEN 
event Window. Update( TRUE); 


deferUpdate := FALSE; 
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001484 CASE what OF 

001485 abort Event: 

001486 event W ndow. Abort Event; 

001487 buttonDown: 

001488 1F who = menuFolder THEN 

001489 event Window. MenuEvent At ( where) 

001490 ELSE 

001491 event Wi ndow. DownEvent At( where); 

001492 folderActivate: 

001493 BEGIN 

001494 currentDocument := eventDocument; 

001495 event W ndow. Activate; 

001496 END; 

001497 folderDeactivate: 

001498 event W ndow. Deactivate: 

001499 fol der Moved: 

001500 BEGIN 

001501 event W ndow. Resi ze( TRUE); 

001502 process. Remember Command(uMoveWi ndow) ; 

001503 END; 

001504 fol derUpdate: 

001505 event Window. Update( TRUE); 

001506 key Down: 

001507 IF event Window. selectPanel = NIL THEN 

001508 {$1 FC fDbgABC} ABCBreak('ObeyTheEvent: selectPanel=NIL', 0) {$ENDC} 
001509 ELSE 

001510 REPEAT 

001511 event Window. select Panel.selection. DoKey(ascii, 
001512 keyCap, shiftKey, appleKey, codeKey); 
001513 

001514 IF PeekEvent(pkEvent) THEN 

001515 paused := (I mActive AND SELF.AbortRequest) OR 
001516 (event Window <> EvtWindow( pkEvent)) OR 
001517 (pkEvent. what <> keyDown) OR 
001518 ((pkEvent. what = keyDown) AND (pkEvent.AppleKey)) {LSR} 
001519 ELSE 

001520 paused := TRUE; 

001521 

001522 |F NOT paused THEN 

001523 BEGIN 

001524 Get Event(event); 

001525 eventTime := event. when; 

001526 eventType := event. what; 

001527 {$1 FC fDbgABC} 

001528 IF eventDebug THEN 

001529 ReportEvent; 

001530 {$ENDC} 

001531 END 
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001532 ELSE 

001533 IF event Window. selectPanel <> NIL THEN 
001534 event Window. select Panel.selection. KeyPause; 
001535 UNTIL paused; 

001536 END; 

001537 

001538 IF (closedDocument = NIL) AND (currentWindow <> NIL) THEN 
001539 BEGIN {+SW+} 

001540 1F NOT deferUpdate THEN 

001541 BEGIN 

001542 1F current Window. dialogBox <> NIL THEN 

001543 current Window. dial ogBox. Update( TRUE); 

001544 current Window. Update( TRUE); 

001545 END; 

001546 IF currentWindow, obj ectToFree <> NIL THEN {+SW+} 
001547 BEGIN 

001548 current Window. obj ect ToFree. Free; 

001549 current Window. objectToFree := NIL 

001550 END; 

001551 END; 

001552 

001553 PopFocus; 

001554 END; 

001555 END; 

001556 

001557 IF closedDocument <> NIL THEN 

001558 BEGIN 

001559 closedDocument. Cl ose(cl osedBySus pend) ; 

001560 cl osedDocument. Free; 

001561 closedDocument := NIL; 

001562 END; 

001563 

001564 process. BindCurrentDocument; {This also unbinds the eventDocument, in the case where 
001565 we got an event while inactive. } 
001566 

001567 {$1FC fCheckHeap AND f DbgABC} 

001568 IF fCountHeap AND (event. what <> buttonUp) THEN 

001569 BEGIN 

001570 numObj ects := CountHeap( mai nHeap) ; 

001571 Write('mainHeap has ', numObjects:1, ' objects'); 

001572 1F boundDocument <> NIL THEN 

001573 BEGIN 

001574 docHeap := boundDocument. docHeap; 

001575 1F docHeap <> NIL THEN 

001576 BEGIN 

001577 numObj ects := CountHeap(docHeap); 

001578 Write('; boundDocument heap has ', numObjects:1, ' objects'); 
001579 MarkHeap(docHeap, ORD( boundDocument.dataSegment. preludePtr*. docDirectory)); 
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SweepHeap(docHeap, TRUE); 


END; 
1F boundClipboard <> NIL THEN 
BEGIN 
docHeap := boundClipboard. docHeap; 
|1F docHeap <> NIL THEN 
BEGIN 
numObj ects := CountHeap(docHeap); 
Write('; boundClipboard heap has ', numObjects:1, ' objects'); 
END; 
END; 
WriteLn; 
END; 
{$ENDC} 


{$I1FC fDebugMet hods} 
IF doclList.Size = 0 THEN 
SELF. Dont Debug; 
{$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sError} 
FUNCTION {TProcess. }Phrase{(error: INTEGER) }; 
VAR erStr: $255; 
BEGIN 
{$1FC fTrace}BP(5); {$ENDC} 
{client can override} 
{also, | should case on os error codes} 
CASE error OF 
erAborted : Phrase := phTermi nated 
OTHERW SE 
BEGIN 
{$1 FC fTrace} 
(** SuErrText('OSERRS.ERR', error, @erStr); **) 


Writeln; 

Writeln('Error #', error, '; ', erStr); 
{$ENDC} 

Phrase := phUnknown; 

END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCcl d} 
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PROCEDURE {TProcess. }HandlePrivateEvent(typeOfEvent: INTEGER; fromProcess: LONGI NT; 


when: LONGINT; otherData: LONGI NT); 


N 
{$I FC fTrace}BP(7); {$ENDC} 
{$IFC fTrace}EP; {$ENDC} 


{$S sRes} 
PROCEDURE {TProcess. }RememberCommand{(cmdNumber: TCmdNumber) }: 
LABEL 1; 


PROCEDURE Call WouldAlert( VAR menu: Menulnfo; itemlndex: I NTEGER) 
BEGIN 

WouldAlert( menu, iteml ndex); 

GOTO 1; 
END; 


BEGIN 
{$1FC fTrace}BP(5); {$ENDC} 
1F NOT menubar. GetCmdName(cmdNumber, NIL) THEN 
cmdNumber := uSomeCommand: 
InAll MenusDo( TRUE, cmdNumber, Call WouldAlert); 
InAl | MenusDo( FALSE, cmdNumber, Call WouldAlert); 
1: 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TProcess. }Run: 
FUNCTION Until Power Off: BOOLEAN 
BEGIN 
Until PowerOff := FALSE; 
END; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
SELF. ObeyEvents( Until Power Off ) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S SgABCcl d} 

PROCEDURE {TProcess. }SendEvent(typeOfEvent: INTEGER; targetProcess: LONGI NT; 
VAR er: EventRecord 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF typeOfEvent < firstPrivateEvent THEN 
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001676 BEGIN 

001677 {$1 FC fDbgABC} 

001678 ABCbreak('Invalid event type passed to TProcess.SendEvent', typeOfEvent); 
001679 {$ENDC} 

001680 END 

001681 ELSE 

001682 BEGIN 

001683 WITH er DO 

001684 BEGIN 

001685 who := NIL; {can't tell what window we are sending to} 
001686 what := typeOfEvent; 

001687 when := Time; 

001688 toProcess := targetProcess 

001689 fromProcess := myProcessiD 

001690 userData := otherData; 

001691 END; 

001692 SendEvent(er, targetProcess); 

001693 END; 

001694 {$I1FC fTrace}EP; {$ENDC} 

001695 END; 

001696 

001697 

001698 {$$ sAlert} 

001699 PROCEDURE {TProcess. }Stop{(phraseNumber: INTEGER) }; 

001700 {$1 FC LibraryVersion > 20} 

001701 VAR dummy: INTEGER 

001702 {$ENDC} 

001703 BEGIN 

001704 {$I1FC fTrace}BP(7); {$ENDC} 

001705 ArgAlert(0, tool Name) 

001706 {$1FC LibraryVersion > 20} 

001707 IF activeWindowlD = 0 THEN 

001708 dummy := BackgroundAlert(alerts, phraseNumber, StopProc) 
001709 ELSE 

001710 {$ENDC} 

001711 StopAlert(alerts, phraseNumber) 

001712 {$I1FC fTrace}EP; {$ENDC} 

001713 END; 

001714 

001715 {$S sStartup} 

001716 PROCEDURE {TProcess. }TrackCursor; { asSumes we are active; can't track the cursor if not } 
001717 VAR cursorNumber: TCursor Number 

001718 BEGIN 

001719 {$IFC fTrace}BP( 3); {$ENDC} 

001720 cursorNumber := noCursor 

001721 1F current Window. dialogBox <> NIL THEN 

001722 BEGIN 

001723 cursorNumber := current Window. dial ogBox. CursorFeedback 
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1F cursorNumber = noCursor THEN 
1F current Window. dial ogBox. downl nMai nWi ndowResponse 
cursorNumber := arrowCursor 
END; 
IF cursorNumber = noCursor THEN 
cursorNumber := current Window. CursorFeedback 
1F cursorNumber = noCursor THEN 
cursorNumber := arrowCursor 
SELF. ChangeCursor(cursorNumber) 
{$IFC fTrace}EP; {$ENDC} 
END: 


{$$ SgABCi ni } 

BEGIN 
Unit Author('Apple'); 
Init Process; 

END; 


METHODS OF TDocDirectory; 


{$8 SgABCi ni } 
FUNCTION {TDocDirectory. }CREATE{(object: TObject; heap: THeap 
itsClass 
VAR world: TClassWorld 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TDocDirectory( object); 


WITH world DO 
BEGIN 
infRecs := TArray(itsClassWorld.infRecs. Cl one(heap)); 
classes := TArray(itsClassWorld.classes.Clone(heap)); (* 
authors := TArray(itsClassWorld. authors. Clone(heap)); (* 
aliases := TArray(itsClassWorld.aliases.Clone(heap)); (* 
END; 

WITH SELF DO 
BEGIN 
window := itsWindow; 


classWorld := world; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$1 FC fDebugMet hods} 


{$8 SgAB 


PROCEDURE {TDocDirectory. }Fields{( PROCEDURE Field(nameAndType: 


BEGIN 


Cdbg} 


Field(' window: TWindow'); 
Field('classList: TList'); 


END; 
{$ENDC} 
{$S SgABCcl d} 

PROCEDURE {TDocDirectory. }Adopt; 
VAR world: TClassWorld: 
heap: THeap; 

BEGIN 


{$IFC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
:= SELF. Heap; 

d := SELF.classWorld; 
WITH world DO 


heap 
worl 


SELF. cl assWorld 


END; 


{$$ SgABCi ni 
END; 


METHODS OF TDocManager; 


{$8 SgAB 
FUNCTI ON 


BEGIN 


BEGIN 


inf Recs. Free; 
classes. Free: 
authors. Free; 
aliases. Free; 


infRecs : 


} 


Ci ni } 


TArray(myWorld., 
TArray(myWorld., 
TArray(myWorld., 
TArray(myWorld., 


:= world; 


(ee) 


inf Recs. Cl one( heap) ) 
classes. Cl one( heap) ) 
authors. Cl one( heap) ) 
aliases. Cl one(heap)) 


{TDocManager. }CREATE{(object: TObject; heap: 
VAR itsVol ume: 


itsFile: 
i: 


TFilePath; 
TFilePath; 
INTEGER; 


THeap; 


$255) )}; 


itsPathPrefix: TFilePath): TDocManager}; 
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{$I1FC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 

object := NewObject(heap, THISCLASS) 
SELF := TDocManager (object); 
SplitFilePath(itsPathPrefix, itsVolume, itsFile) 
WITH SELF.files DO 


BEGIN 
volumePrefix := itsPathPrefix; 
volume := itsVol ume; 
{$1FC LibraryVersion > 20} 
password := ''; 
{$ENDC} 
shouldSuspend := TRUE; 
shouldToolSave := FALSE; 
END; 
WITH SELF. dataSegment DO 
BEGIN 
preludePtr := NIL; 
FOR i := 1 TO maxSegments DO 
refnum[i] := -1; 
changes := 0; 
END; 
WITH SELF DO 
BEGIN 


window := NIL; 
pendingNote := 0; 
docHeap := NIL; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$1 FC fDebugMet hods} 
{$S SgABCdbg} 


PROCEDURE {TDocManager. }Fields{( PROCEDURE Field(nameAndType: 


BEGIN (* TFilePath = STRING[ 255]; maxSegments = 6 *) 


Field(CONCAT('files: RECORD volumePrefix: STRING[255]; volume: 


$255) )}; 


STRING 255]; 


‘saveExists: BOOLEAN; shouldSuspend: BOOLEAN; shouldTool Save: BOOLEAN; END')); 


Field('dataSegment: RECORD refnum: ARRAY [1..6] OF INTEGER 


Field('docHeap: Ptr') 

Field(' window: TWindow'); 
Field('pendingNote: I NTEGER'); 
Field('openedAsTool: BOOLEAN' ) 


Field(''); 
END; 
{$S SgABCres} 
{$ENDC} 


preludePtr: 
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password: STRING[32];', 


END' ); 
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001868 

001869 

001870 {$8 SgABCcl d} 

001871 PROCEDURE {TDocManager. }Assimilate{(VAR error: INTEGER) }; 
001872 VAR hz: THz; 

001873 exDocDirectory: TDocDirectory; 

001874 exClasses: TCl assWorld; 

001875 doConvert: BOOLEAN 

001876 olderVersion: BOOLEAN 

001877 newer Version: BOOLEAN 

001878 BEGIN 

001879 {$I1FC fTrace}BP(7); {$ENDC} 

001880 hz := POI NTER(ORD( SELF. docHeap) ); 

001881 hz*. procChMore := @ExpandHeap; {The code address may have changed} 
001882 

001883 error := 0; 

001884 WITH SELF. dataSegment. preludePtr* DO 

001885 BEGIN 

001886 exDocDirectory := docDirectory; 

001887 exClasses := exDocDirectory.class World; 

001888 IF password <> 25376 THEN {***temporary***} 

001889 error := erPassword 

001890 END; 

001891 

001892 (**) IF error <= 0 THEN 

001893 IF NeedConversion(exClasses, olderVersion, newerVersion) THEN 
001894 BEGIN 

001895 IF newerVersion THEN 

001896 doConvert := process. Caution( phNewer Versi on) 
001897 ELSE 

001898 IF olderVersion THEN 

001899 doConvert := process. Caution( phOl der Versi on) 
001900 ELSE 

001901 doConvert := TRUE; 

001902 

001903 IF doConvert THEN 

001904 BEGIN 

001905 process. Begi nWait(phConverting) 

001906 allowAbort := FALSE; {cannot abort the conversion} 
001907 

001908 ConvertHeap(SELF.docHeap, exClasses) 

001909 exDocDirectory. Adopt; (***) 

001910 SELF. ConserveMemory(docExcess, TRUE {GC}) 
001911 

001912 allowAbort := TRUE; 

001913 process. EndWait; 

001914 END 

001915 ELSE 
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error := erVersi on: 
END; (**) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TDocManager. }Bind 
VAR i: INTEGER; 
error: INTEGER; 
sched_err: INTEGER; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
I1F boundDocument <> SELF THEN 
BEGIN 
1F boundDocument <> NIL THEN 
boundDocument. Unbind 


i:el; {We must bind segment #1 before we can find out numSegments} 
REPEAT 
Sched_Class(sched_err, FALSE); 
Bind DataSeg(error, SELF. dataSegment.refnuml[i]); 
Sched_Class(sched_err, TRUE); 


IF error > 0 THEN 
ABCBreak(' Bind DataSeg', error); 
i:=i +1; 
UNTIL i > SELF. dataSegment. preludePtr*. numSegments; 


boundDocument := SELF: 
END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$S SgABCcl d} 
PROCEDURE {TDocManager. }Close{(afterSuspend: BOOLEAN) }; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
1F SELF = currentDocument THEN 
BEGIN 
current Document := 
current Window := NI 
activeWndowlD := 0; 
END; 


NIL; 
L; 


|F NOT afterSuspend THEN 
SELF. Kill Segments(1, maxSegments); 
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docList. Del Object(SELF, FALSE); 
1F SELF = boundDocument THEN 
boundDocument := NIL; 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$5 SgABCcl d} 

PROCEDURE {TDocManager. }Cl oseFiles 

BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
{ For the application to override IF it needs to close any of its own files } 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$$ SgABCi ni } 
PROCEDURE {TDocManager. }Complete{(alllsWell: BOOLEAN) }; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
{**** Try to save the document, code needed here, ****} 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCcl d} 
PROCEDURE {TDocManager. }ConserveMemory{(maxExcess: LONGINT; fGC: BOOLEAN) }; 


VAR heap: THeap; 
hz: THz; 
bytesReduced: LONGI NT; 
error: INTEGER; 

BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 
IF SELF <> clipboard THEN 
BEGIN 
heap := SELF. docHeap; 


1F fGC THEN 
BEGIN 
MarkHeap( heap, ORD(SELF.dataSegment. prel udePtr*.docDirectory)); 
{$1 FC fDbgABC} 


SweepHeap( heap, TRUE); {Report garbage} 
{$ELSEC} 
SweepHeap(heap, FALSE); {Free garbage} 
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{$$ 
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{$ENDC} 
END; 


hz := POINTER( ORD( heap) ) 
REPEAT 


bytesReduced := CbhShrinkHz(hz, maxSegSi ze) 


UNTIL bytesReduced < maxSegSize 


SELF. SetSegSize(error, ChOfHz(hz) + SELF.dataSegment. preludePtr*. preludeSize, maxExcess); 


IF error > 0 THEN 
process. Compl ete( FALSE); 
END; 
{$1FC fTrace}EP; {$ENDC} 


SgABCres} 


SgABCcl d} 


PROCEDURE {TDocManager. }Deacti vate; 


BEGI 


END; 
{$5 


{$$ 


N 

{$I1FC fTrace}BP(7); {$ENDC} 

1F SELF = currentDocument THEN 
BEGIN 
current Window := NI 
current Document := 
END; 


allowAbort := FALSE; 
SELF. ConserveMemory(docExcess, FALSE {no GC}) 
allowAbort := TRUE; 


SELF. Unbi nd; 
{$I1FC fTrace}EP; {$ENDC} 


SgABCres} 


SgABCi ni} 


FUNCTION {TDocManager. }DfltHeapSize{: LONGI NT}; 


BEGI 


END; 
{$5 


N 

{$IFC fTrace}BP( 3); {$ENDC} 
DfltHeapSize := docDsBytes; 
{$I1FC fTrace}EP; {$ENDC} 


SgABCres} 


L; 
NIL; {so we can unbind the document } 
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{$1 FC fDbgABC} 
{$S SgABCdbg} 
PROCEDURE {TDocManager. }DumpPrel ude 
VAR preludePtr: TPPrelude; {needed so WITH doesn't complain about $H+} 


PROCEDURE AbortDumpVar(pVariable: Ptr; nameAndType: $255); 


BEGIN 
IF CheckKeyPress('Document prelude dump') THEN 
BEGIN 
WriteLn; 
WriteLn; 
Exit(DumpPrel ude); 
END; 
DumpVar(pVariable, nameAndType) ; 
END; 
BEGIN 
WriteLn; 
WriteLn('--- PRELUDE OF THE DOCUMENT ---'); 
WriteLn; 


preludePtr := SELF. dataSegment. preludePtr 
WITH preludePtr* DO 
BEGIN 
Abort DumpVar(@password, ‘password: I NTEGER'); 
Abort DumpVar(@version, ‘version: I NTEGER'); 
Abort DumpVar(@country, ‘country: INTEGER'); 
Abort DumpVar(@language, ‘language: I NTEGER' ) 
Abort DumpVar( @preludeSize, ‘preludeSize: I NTEGER' ) 
Abort DumpVar(@docSize, ‘docSize: LONGINT'); 
Abort DumpVar(@numSegments, ‘numSegments: I NTEGER'); 
Abort DumpVar(@docDirectory, ‘docDirectory: TDocDirectory'); 
END; 
WriteLn; 
WriteLn; 
END; 
{$S SgABCres} 
{$ENDC} 


{$8 sCldl nit} 
PROCEDURE {TDocManager. }ExpandMemory{(bytesNeeded: LONGI NT) }; 
VAR error: INTEGER; 

BEGIN 

{$IFC fTrace}BP(7); {$ENDC} 

SELF. SetSegSize(error, SELF. dataSegment. preludePtr*.docSize + bytesNeeded, docExcess); 
IF error > 0 THEN 

process. Compl ete( FALSE); 

{$1FC fTrace}EP; {$ENDC} 
END; 
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{$S SgABCres} 


{$S SgABCcl d} 
PROCEDURE {TDocManager. }KillSegments{(first, last: INTEGER) }; 


VAR i: INTEGER; 
dsPathname: Pat hName: 
{$1FC LibraryVersion > 20} 
ds Password: E_Name; 
bl ankPasswd: E_ Name; 
{$ENDC} 
error: INTEGER; 

BEGIN 
{$1 FC fTrace}BP(7); {$ENDC} 
error := 0; 


{$1FC LibraryVersion > 20} 

dsPassword := SELF.files. password 

blankPasswd :='': 

{$ENDC} 

FOR i := first TO last DO 

|F SELF. dataSegment.refnum[i] >= 0 THEN 

BEGIN 
dsPathName := CONCAT(SELF.files.volumePrefix, suspendSuffix[i]); 
{$1FC LibraryVersion > 20} 
Change Password(error, dsPathname, dsPassword, bl ankPasswd); 
{$ENDC} 
Kill _DataSeg(error, dsPathname) ; 
Close DataSeg(error, SELF. dataSegment.refnum[i]) 
SELF. dataSegment.refnum[i] := -1; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sCldl nit} 
PROCEDURE {TDocManager. }MakeSegments{(VAR error: INTEGER; oldSegments: INTEGER; newDocSize 
TYPE TempType = ARRAY [1..MAXINT] OF Byte; 
PTempType = “TempType 
VAR currDocSi ze: LONGI NT; 
newSegments: INTEGER; 
i: INTEGER; 
ldsn: INTEGER; 
thisSegSi ze: LONGI NT; 
dsPathname: Pat hName: 
dsRef num: INTEGER; 
me mOr d: LONGI NT; 
dsinfo: DsI nf oRec; 
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002156 newSi ze: LONGI NT; 

002157 p: PTempType; 

002158 {$1FC LibraryVersion > 20} 

002159 ds Password: E_ Name; 

002160 bl ankPasswd: E_Name; 

002161 {$ENDC} 

002162 sched_err: INTEGER 

002163 BEGIN 

002164 {$I1FC fTrace}BP(7); {$ENDC} 

002165 IF (boundDocument <> NIL) AND ((boundDocument <> SELF) OR (oldSegments = 0)) THEN 
002166 boundDocument. Unbi nd; {*** This may be dispensable ***} 

002167 

002168 error := 0; 

002169 

002170 1F (oldSegments > 0) THEN 

002171 BEGIN 

002172 {expand the current last data segment out to maxSegSize 

002173 we assume that the caller has already checked that a new segment is actually needed} 
002174 

002175 dsRefnum:= SELF. dataSegment. ref num[ ol dSegments] 

002176 

002177 Info DataSeg(error, dsRefnum, dslinfo) 

002178 

002179 IF error <= 0 THEN 

002180 BEGIN 

002181 Sched Class(sched err, FALSE) 

002182 Size DataSeg(error, dsRefnum, maxSegSize - dsilnfo.memsize, newSize 
002183 maxSegSize - dsinfo.disc_ size, newSize) 
002184 Sched Class(sched err, TRUE) 

002185 END 

002186 ELSE 

002187 ABCbreak('In MakeSegments, error fromInfo Dataseg', error); 
002188 END; 

002189 

002190 currDocSize := oldSegments* maxSegSi ze 

002191 newSegments := ol dSegments; 

002192 

002193 {$1FC LibraryVersion > 20} 

002194 dsPassword := SELF.files. password; 

002195 bl ankPasswd := ''' 

002196 {$ENDC} 

002197 

002198 WHILE (currDocSize < newDocSize) AND (error <= 0) DO 

002199 BEGIN 

002200 newSegments := newSegments + 1; 

002201 Idsn := newSegments + docLdsn-1; 

002202 thisSegSize := Min(newDocSize - currDocSize, maxSegSi ze) 

002203 thisSegSize := Lint Mull nt(LintDivint(thisSegSize + 511, 512), 512) 
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dsPathname := CONCAT(SELF.files.volumePrefix, suspendSuffix[newSegments]); 


{$1FC LibraryVersion > 20} 
Change Password(error, dsPathname, dsPassword, bl ankPasswd) 
{$ENDC} 


Open_Dataseg(error, dsPathname, dsRefnum, memOrd, I dsn) 


{$1 FC fDbgABC} 
1F error > 0 THEN 

WriteLn('In TDocManager.MakeSegments: error from Open Dataseg=', error:1) 
{$ENDC} 


IF error > 0 THEN 
BEGIN 
Sched_Class(sched_err, FALSE); 
Make Dataseg(error, dsPathname, thisSegSize, thisSegSize, dsRefnum, memOrd, Idsn, 
Sched_Class(sched_err, TRUE); 
END 
ELSE 
BEGIN 
SetAccess DataSeg(error, dsRefnum, FALSE); {Make writeable} 
IF error <= 0 THEN 
BEGIN 
Info DataSeg(error, dsRefnum, dsinfo); 
IF error <= 0 THEN 
BEGIN 
Sched Class(sched_ err, FALSE); 
Size DataSeg(error, dsRefnum, thisSegSize - dsinfo.mem size, newSize 
thisSegSize - dsinfo.disc_size, newSize); 
Sched Class(sched_err, TRUE); 
END; 
END; 
END; 


IF error > 0 THEN 
ABCBreak('In TDocManager. MakeSegments: Make Dataseg', error) 
ELSE 
BEGIN 
{$1FC LibraryVersion > 20} 
Change Password(error, dsPathname, blankPasswd, dsPassword); 
IF error > 0 THEN 
ABCBreak('In TDocManager. MakeSegments: Change Password’, error); 
{$ENDC} 


SELF. dataSegment.refnum[newSegments] := dsRef num 


IF I dsn = docLdsn THEN 
p := POINTER( mem0rd); 
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END; 


currDocSize := currDocSize + thisSegSize 
IF process. AbortRequest THEN 

error := erAborted 
END; 


IF error <= 0 THEN 
WITH SELF. dataSegment DO 


BEGIN 
IF oldSegments = 0 THEN 
BEGIN 
boundDocument := SELF; 
FOR i := 1 TO SIZEOF(TPrelude) DO 
p*Li] := 0; 
preludePtr := POINTER( ORD(p)); 
END; 
preludePtr*.docSize := currDocSize 
preludePtr*.numSegments := newSegments; 
END; 


{$I1FC fTrace}EP; {$ENDC} 


{$$ Override} 
FUNCTION {TDocManager. }NewWi ndow{(heap: THeap; wmgrlD: TWindowl D): TWindow}; 
BEGIN 

{$I FC fTrace}BP(7); {$ENDC} 

NewWi ndow := TWindow. CREATE(NIL, heap, wmgrlD, TRUE) 

{$I FC fTrace}EP; {$ENDC} 


END; 
{$S sCldl nit} 
PROCEDURE {TDocManager. }Open{(VAR error: INTEGER; wmgrlD: TWindowlD; VAR openedSuspended 
LABEL 1; 
VAR aFile: TFile; 
vol umePrefix: TFilePath; 
pWi ndow: Wi ndowPtr; 
wi ndow: TWi ndow 
BEGIN 


{$1 FC fTrace}BP(7); {$ENDC} 
openedSuspended := FALSE; 
volumePrefix := SELF.files. vol umePrefix: 


[F SELF.files.shouldToolSave OR NOT SELF. openedAsTool THEN 
BEGIN 


BOOLEAN) }; 
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002300 aFile := TFile. CREATE(NIL, mainHeap, volumePrefix, ''); 
002301 

002302 {Look for the save file} 

002303 1F NOT aFile. Exists(error) THEN 

002304 BEGIN 

002305 aFile,Become(TFile. CREATE(NIL, mainHeap, CONCAT(volumePrefix, ‘'$T'), '')); 
002306 IF aFile. Exists(error) THEN 

002307 aFile. Rename(error, vol umePrefi x) 

002308 END; 

002309 

002310 aFile. Free; 

002311 

002312 SELF.files.saveExists := error <= 0; 

002313 END 

002314 ELSE 

002315 SELF.files.saveExists := FALSE: 

002316 

002317 IF process. AbortRequest THEN 

002318 BEGIN 

002319 error := erAborted; 

002320 GOTO 1; 

002321 END; 

002322 

002323 {Try to open suspend files first, THEN the save file, THEN blank stationery} 
002324 [F SELF.files.shouldSuspend THEN 

002325 SELF. OpenSuspended(error, wmgrl D) 

002326 ELSE {don't even try the suspend file} 

002327 error := erNameNot Found 

002328 

002329 IF error > 0 THEN 

002330 IF error <> erAborted THEN 

002331 IF SELF.files.saveExists THEN {won't even try this if we don't create save files} 
002332 SELF. OpenSaved(error, wmgrl D) 

002333 ELSE 

002334 SELF. OpenBlank(error, wmgrl D) 

002335 ELSE 

002336 openedSuspended := TRUE 

002337 ELSE 

002338 openedSuspended := TRUE; 

002339 

002340 1F error <= 0 THEN 

002341 BEGIN 

002342 SELF. dataSegment. changes := 0; 

002343 

002344 window := SELF. dataSegment. preludePtr*.docDirectory. window 
002345 SELF. window := window 

002346 

002347 window. Set Wmgrld(wmgrlD); {changes the wmgrid of the window and the port of the panes} 
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pWi ndow := POI NTER( wmgr! D); 
SetFldrRefCon(pWndow, ORD( SELF) ) 


docList. I nsLast(SELF); 
END 
ELSE 
|F NOT openedSuspended THEN 
SELF. Kill Segments(1, maxSegments); {*** Good idea?} 


{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 
{$8 sCldl nit} 


PROCEDURE {TDocManager. }OpenBlank{(VAR error: INTEGER; wmgrlD: TWindowlD)}; 
LABEL 1; 


VAR heapSi ze: LONGI NT; 
heapStart: LONGI NT; 
docHeap: THeap; 
prPrfAlias: TPrPrfAlias; 
obj Count: INTEGER 
docWi ndow: TWi ndow; 


docDirectory: TDocDirectory; 


PROCEDURE CheckAbort; 


BEGIN 
IF process. AbortRequest THEN 

BEGIN 
error := erAborted; 
GOTO 1; 
END; 

END; 

BEGIN 


{$1 FC fTrace}BP(7); {$ENDC} 
heapSize := SELF. DfltHeapSize 
SELF. MakeSegments(error, 0, heapSize + SI ZEOF(TPrelude)); 


1F error <= 0 THEN 
BEGIN 
heapStart := ORD(SELF.dataSegment. preludePtr) + SI ZEOF(TPrel ude) 


docHeap := POINTER( ORD(HzI nit(POINTER(heapStart), POINTER( heapStart theapSi ze) 
NIL, Li ntDivint(heapSize, 10), 0, @ExpandHeap, 
POINTER(procNil), POINTER(procNil), POINTER(procNil)))); 
{*** DANGER ***} 
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002396 {@ExpandHeap is a pointer outside the data segment} 
002397 {TDocManager.Assimilate must guarantee its accuracy} 
002398 

002399 CheckAbort; 

002400 PrPrfDefault(prPrfAlias. prPrf); 

002401 WITH SELF. dataSegment.preludePtr* DO 

002402 BEGIN 

002403 password := 25376; {*** temporary ***} 

002404 version := 1; {*** should be this software's version ***} 
002405 country := countryCode 

002406 language := countryCode; {*** same as country code? ***} 
002407 preludeSize := SI ZEOF(TPrel ude) 

002408 printPref := prPrfAlias. reserve 

002409 END; 

002410 SELF.docHeap := docHeap; 

002411 docWindow := SELF. NewWi ndow(docHeap, wmgrl D) 

002412 docDirectory := TDocDirectory. CREATE(NIL, docHeap, docWindow, myWorld) 
002413 

002414 SELF. dataSegment. preludePtr*.docDirectory := docDirectory 
002415 docWi ndow. Bl ankStati onery; 

002416 CheckAbort; 

002417 {$1 FC fDbgABC} 

002418 (* docWi ndow. CheckPanels;*** Should check that union of panel rects = window rect ***) 
002419 {$ENDC} 

002420 END; 

002421 1: {$IFC fTrace}EP; {$ENDC} 

002422 END; 

002423 {$S SgABCres} 

002424 

002425 

002426 {$8 SgABCcl d} 

002427 PROCEDURE {TDocManager. }OpenSaved{( VAR error: INTEGER; wmgrlD: TWindowl D)}; 
002428 VAR vol umePrefi x: TFilePath; 

002429 aFile: TFile; 

002430 fs: TFil eScanner; 

002431 fileSize: LONGI NT; 

002432 preludePtr: TPPrelude 

002433 BEGIN 

002434 {$I1FC fTrace}BP(7); {$ENDC} 

002435 volumePrefix := SELF.files. vol umePrefix: 

002436 {$1FC LibraryVersion <= 20} 

002437 aFile := TFile. CREATE(NIL, mainHeap, volumePrefix, '') 

002438 {$ELSEC} 

002439 aFile := TFile. CREATE(NIL, mainHeap, volumePrefix, SELF. files. password) 
002440 {$ENDC} 

002441 fs := aFile.ScannerFrom(0, [fRead]) 

002442 error := fS.error 

002443 
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002444 1F error <= 0 THEN 

002445 BEGIN 

002446 fileSize := aFile.size 

002447 SELF.MakeSegments(error, 0, fileSize) 

002448 IF error <= 0 THEN 

002449 BEGIN 

002450 preludePtr := SELF.dataSegment. prel udePtr; 
002451 process. AbortXferSequential(xRead, POINTER(ORD(preludePtr)), fileSize, abortChunkSize, fs) 
002452 error := fs.error: 

002453 IF error <= 0 THEN 

002454 SELF. ResumeAfterOpen(error, wmgrlD); 
002455 preludePtr*.docDirectory. window. changes := 0; 
002456 END; 

002457 fs. Free; {Close the file & free the TFile object} 
002458 END; 

002459 {$I1FC fTrace}EP; {$ENDC} 

002460 END: 

002461 {$S SgABCres} 

002462 

002463 

002464 {$$ SgABCi ni } 

002465 PROCEDURE {TDocManager. }OpenSuspended{(VAR error: INTEGER; wmgrlD: TWi ndowl D)}; 
002466 VAR vol umePrefi x: TFilePath; 

002467 i: INTEGER; 

002468 ldsn: INTEGER; 

002469 dsPathname: Pat hName; 

002470 dsRef num: INTEGER; 

002471 me mOr d: LONGI NT; 

002472 preludePtr: TPPrelude 

002473 cease: BOOLEAN; 

002474 {$1FC LibraryVersion > 20} 

002475 ds Password: E_ Name; 

002476 bl ankPasswd: E_ Name; 

002477 {$ENDC} 

002478 otherError: INTEGER 

002479 BEGIN 

002480 {$I1FC fTrace}BP(7); {$ENDC} 

002481 1F boundDocument <> NIL THEN 

002482 boundDocument. Unbi nd: 

002483 

002484 volumePrefix := SELF.files. vol umePrefix: 

002485 {$1FC LibraryVersion > 20} 

002486 dsPassword := SELF.files. password; 

002487 bl ankPasswd := '' 

002488 {$ENDC} 

002489 

002490 {loop invariant: i = # datasegs already bound + 1} 
002491 feel 
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002492 
002493 
002494 
002495 
002496 
002497 
002498 
002499 
002500 
002501 
002502 
002503 
002504 
002505 
002506 
002507 
002508 
002509 
002510 
002511 
002512 
002513 
002514 
002515 
002516 
002517 
002518 
002519 
002520 
002521 
002522 
002523 
002524 
002525 
002526 
002527 
002528 
002529 
002530 
002531 
002532 
002533 
002534 
002535 
002536 
002537 
002538 
002539 
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REPEAT 
ldsn := i + docLdsn-1; 
dsPathname := CONCAT(volumePrefix, suspendSuffix[i]); 
IF currentDocument <> NIL THEN {*** Get around OS anomaly ***} 
error := 313 {*** What it should return for Revert ***} 
ELSE {*** Remove these lines when fixed ***} 
BEGIN 


{$1FC LibraryVersion > 20} 

Change Password(error, dsPathname, dsPassword, bl ankPasswd); 
{$ENDC} 

Open _DataSeg(error, dsPathname, dsRefnum, memOrd, I dsn); 


IF error <= 0 THEN 
BEGIN 
SELF. dataSegment.refnum[i] := dsRefnum 
IF ldsn = doclLdsn THEN 
preludePtr := POI NTER( memOrd); 
SetAccess DataSeg(error, dsRefnum, FALSE); {Make writeable} 
IF error > 0 THEN 
ABCBreak('In TDocManager. OpenSuspended: SetAccess DataSeg', error); 
{$1FC LibraryVersion > 20} 
Change Password(error, dsPathname, blankPasswd, dsPassword); 
IF error > 0 THEN 
ABCBreak('In TDocManager. OpenSuspended: Change Password’, error) 
{$ENDC} 
i:=i +1; 
END; 


IF process. AbortRequest THEN 
error := erAborted 


1F error > 0 THEN 


cease := TRUE 
ELSE 
cease := i > preludePtr*. numSegments; 
UNTIL cease; 


IF error <= 0 THEN 
BEGIN 
SELF. dataSegment. preludePtr := preludePtr 
boundDocument := SELF; 
SELF. ResumeAfterOpen(error, wmgrlD); 
END 
ELSE 
WHILE i > 1 DO {back out by unbinding the datasegs} 
BEGIN 
i:ezi- 1; 
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002540 Unbind Dataseg(otherError, SELF. dataSegment.refnumf[i ]) 

002541 {$1 FC fDbgABC} 

002542 IF otherError > 0 THEN 

002543 WriteLn(CHR(7), ‘Error unbinding dataseg=', otherError:1) 
002544 {$ENDC} 

002545 SELF. dataSegment.refnum[i] := -1; 

002546 END; 

002547 {$I1FC fTrace}EP; {$ENDC} 

002548 END; 

002549 {$S SgABCres} 

002550 

002551 

002552 {$8 SgABCcl d} 

002553 PROCEDURE {TDocManager. }ResumeAfterOpen{(VAR error: INTEGER; wmgr!D: TW ndowl D) }; 
002554 VAR preludePtr: TPPrelude 

002555 docHeap: THeap; 

002556 obj Count: INTEGER 

002557 BEGIN 

002558 {$1FC fTrace}BP(1); {$ENDC} 

002559 error := 0; 

002560 

002561 preludePtr := SELF. dataSegment. preludePtr 

002562 docHeap := POINTER(ORD( preludePtr) + preludePtr~*. prel udeSi ze); 

002563 SELF.docHeap := docHeap 

002564 SELF. Assimilate(error); 

002565 (***** 

002566 IF NOT fCheckHzOK( POI NTER(ORD(docHeap)), obj Count) THEN 

002567 BEGIN 

002568 ABCBreak('fCheckHzOK failed on suspend file: obj Count', obj Count) 
002569 error := erlnternal 

002570 END 

002571 ELSE 

002572 BEGIN 

002573 SELF.docHeap := docHeap; 

002574 SELF. Assimlate(error); 

002575 END; 

002576 *****) 

002577 {$1FC fTrace}EP; {$ENDC} 

002578 END; 

002579 {$S SgABCres} 

002580 

002581 

002582 {$S SgABCcl d} 

002583 PROCEDURE {TDocManager. }RevertVersion{(VAR error: INTEGER; wmgrlD: TWi ndowl D)}; 
002584 { for now, must be the active window to do this } 
002585 VAR dontCare: BOOLEAN 

002586 BEGIN 

002587 {$I1FC fTrace}BP(1); {$ENDC} 
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002588 
002589 
002590 
002591 
002592 
002593 
002594 
002595 
002596 
002597 
002598 
002599 
002600 
002601 
002602 
002603 
002604 
002605 
002606 
002607 
002608 
002609 
002610 
002611 
002612 
002613 
002614 
002615 
002616 
002617 
002618 
002619 
002620 
002621 
002622 
002623 
002624 
002625 
002626 
002627 
002628 
002629 
002630 
002631 
002632 
002633 
002634 
002635 
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error := 0; 


SELF. Cl ose( FALSE); 


{ active/current Window/ Document should have been made NIL by SELF.Close } 


current Document := SELF: 


{We could be cleverer and reuse the old data segments, later****} 


allowAbort := FALSE; {no abort allowed during revert} 
SELF. Open(error, wmgrlD, dontCare); 
allowAbort := TRUE; 
IF error > 0 THEN 
BEGIN 


{$1 FC fDbgABC} 
ABCBreak('RevertVersion error opening document', error) 
{$ENDC} 
END 
ELSE 
BEGIN 
PushFocus: 
current Window := SELF. window 
activeWi ndowl D := current Window. wmgrl D; 
current Window, Focus 
current Window. Resi ze( FALSE) 
Inval Rect (current Wi ndow.innerRect); 
current Window. Update( TRUE) 
PopFocus; 


END; 
{$I1FC fTrace}EP; {$ENDC} 


END; 
{$S SgABCres} 


{$$ SgABCcl d} 


PROCEDURE {TDocManager. }SaveVersion{( VAR error: INTEGER; volumePrefix: 


VAR tmpFile: TFile; 
fs: TFil eScanner; 
saveFile: TFile; 
local Error: INTEGER 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
error := 0; 


SELF. dataSegment. preludePtr*.docDirectory. window := SELF. window 
1F NOT andContinue THEN 


TFilePath; andContinue: BOOLEAN) }; 


{Just in case it somehow changed} 


{*** Revert to one pane per panel scrolled to the beginning & no (or standard) selection***}; 


IF process. AbortRequest THEN 
error := erAborted 
ELSE 


Apple Lisa ToolKit 3.0 Source Code Listing 


145 of 1012 


Apple Lisa Computer Technical Information 


002636 BEGIN 

002637 {SELF. Rel easeDiskSpace...; *** TQ DO **ONLY | F** WE CAN'T GET ENOUGH SPACE WITHOUT ***} 
002638 IF process. AbortRequest THEN 

002639 error := erAborted 

002640 ELSE 

002641 BEGIN 

002642 {$1FC LibraryVersion <= 20} 

002643 tmpFile := TFile. CREATE(NIL, mainHeap, CONCAT(volumePrefix, '$T'), '') 

002644 {$ELSEC} 

002645 tmpFile := TFile. CREATE(NIL, mainHeap, CONCAT(volumePrefix, '$T'), SELF. files. password) 
002646 {$ENDC} 

002647 fs := tmpFile.ScannerFrom(0, [fWrite]); 

002648 error := fs.error: 

002649 

002650 IF error <= 0 THEN 

002651 IF process. AbortRequest THEN 

002652 error := erAborted 

002653 

002654 1F error > 0 THEN 

002655 BEGIN 

002656 tmpFile.Delete(localError); 

002657 fs, Free: 

002658 END 

002659 ELSE 

002660 BEGIN 

002661 process. AbortXferSequential(xWrite, POI NTER( ORD(SELF. dataSegment. preludePtr)), 
002662 SELF. dataSegment. preludePtr*.docSize, abortChunkSize, fs) 
002663 fs. Compact; 

002664 {*** we should set the logical file size to the logical EOF ***} 

002665 

002666 error := fS.error 

002667 {*** Be sure buffers are flushed ***} 

002668 

002669 IF error <= 0 THEN 

002670 IF process. AbortRequest THEN 

002671 error := erAborted; 

002672 

002673 IF error > 0 THEN 

002674 BEGIN 

002675 {$1 FC fDbgABC} 

002676 ABCbreak('In TDocManager.SaveVersion, error saving file=', error) 

002677 {$ENDC} 

002678 

002679 {this is after we wrote out the file, need a wait alert if user aborted} 
002680 IF error = erAborted THEN 

002681 process. Begi nWait(phAborti ng); 

002682 tmpFile. Delete(localError); 

002683 
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002684 
002685 
002686 
002687 
002688 
002689 
002690 
002691 
002692 
002693 
002694 
002695 
002696 
002697 
002698 
002699 
002700 
002701 
002702 
002703 
002704 
002705 
002706 
002707 
002708 
002709 
002710 
002711 
002712 
002713 
002714 
002715 
002716 
002717 
002718 
002719 
002720 
002721 
002722 
002723 
002724 
002725 
002726 
002727 
002728 
002729 
002730 
002731 


ELSE 


END; 
END; 


END; 
{$I FC fTrace}EP 


END; 
{$S SgABCres} 


{$S sStartup} 


Apple Lisa Computer Technical Information 


{$1 FC fDbgABC} 
IF localError > 0 THEN 

ABCbreak('In TDocManager.SaveVersion, error deleting file=', local Error) 
{$ENDC} 


process. EndWait; 
fs. Free; 
END 


BEGIN 
fs. FreeObject; {don't free tmpFile yet} 
IF SELF. files.saveExists THEN 
BEGIN 
{$1FC LibraryVersion <= 20} 
saveFile := TFile.CREATE(NIL, mainHeap, volumePrefix, ''); 
{$ELSEC} 
saveFile := TFile.CREATE(NIL, mainHeap, volumePrefix, SELF.files. password); 
{$ENDC} 
saveFile. Delete(local Error); 
saveFile. Free; 
END; 
SELF.files.saveExists := TRUE; 
tmpFile.Rename(localError, volumePrefi x); 


{$1 FC fDbgABC} 
IF localError > 0 THEN 

ABCbreak('In TDocManager. SaveVersion, error renaming file=', local Error) 
{$ENDC} 


t mpFile. Free; 


SELF. window. changes := 0; 
END; 


{$ENDC} 


PROCEDURE {TDocManager. }SetSegSize{(VAR error: INTEGER; minSize, maxExcess: LONGI NT) }; 
{Make the memory and disk size of the virtual data segment be at least as indicated, and leave 
some excess, but no more than the maximumindicated. Update docSize, numSegments, and the 


refnum table. 
The virtual 


Assumptions: 
data segment exists and is open and bound 


It has at least one real data segment, and has a valid heap that fits in the 
lesser of the current diskSize and the new diskSize. 


Apple 
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002732 All LONG parameters are rounded up IF necessary to a multiple of 512 before they are used. } 
002733 

002734 VAR preludePtr: TPPrel ude 

002735 dsinfo: DsI nf oRec; 

002736 ol dMemSi ze: LONGI NT; 

002737 newSi ze: LONGI NT; 

002738 newSegments: INTEGER 

002739 newSegSi ze: LONGI NT; 

002740 temp: LONGI NT; 

002741 sched_err: INTEGER; 

002742 BEGIN 

002743 {$I1FC fTrace}BP(7); {$ENDC} 

002744 error := 0; 

002745 

002746 mi nSize := Lint Mull nt(LintDivint(minSize + 511, 512), 512) 

002747 maxExcess := LintMull nt(LintDivint(maxExcess + 511, 512), 512); 

002748 

002749 preludePtr := SELF. dataSegment. preludePtr 

002750 

002751 WITH preludePtr* DO 

002752 BEGIN 

002753 Info DataSeg(error, SELF.dataSegment.refNum[ numSegments], dsinfo) 
002754 1F error > 0 THEN 

002755 ABCBreak('SetSegSize: Info Dataseg', error) 

002756 

002757 oldMemSize := dsinfo.mem size + (maxSegSize*(numSegments-1) ) 

002758 

002759 IF (oldMemSize < minSize) OR (oldMemSize > minSize + maxExcess) THEN 
002760 {need to adjust the segment size} 

002761 BEGIN 

002762 newSize := minSize + maxExcess: 

002763 newSegments := LintDivLInt(newSize + maxSegSize - 1, maxSegSize) 
002764 

002765 {$1 FC fDbgABC} 

002766 IF (numSegments < 1) OR (numSegments > maxSegments) THEN 

002767 ABCBreak('SetSegSize: numSegments NOT IN 1..maxSegments', numSegments); 
002768 IF (newSegments < 1) OR (newSegments > maxSegments) THEN 

002769 ABCBreak('SetSegSize: newSegments NOT IN 1..maxSegments', newSegments); 
002770 {$ENDC} 

002771 

002772 IF numSegments > newSegments THEN 

002773 {kill off whole segments we don't need anymore} 

002774 SELF. Kill Segments(newSegments + 1, numSegments) 

002775 ELSE 

002776 IF numSegments < newSegments THEN 

002777 SELF. MakeSegments(error, numSegments, newSi ze) 

002778 {this sets all the segment sizes correctly} 

002779 


Apple Lisa ToolKit 3.0 Source Code Listing -- 148 of 1012 


002780 
002781 
002782 
002783 
002784 
002785 
002786 
002787 
002788 
002789 
002790 
002791 
002792 
002793 
002794 
002795 
002796 
002797 
002798 
002799 
002800 
002801 
002802 
002803 
002804 
002805 
002806 
002807 
002808 
002809 
002810 
002811 
002812 
002813 
002814 
002815 
002816 
002817 
002818 
002819 
002820 
002821 
002822 
002823 
002824 
002825 
002826 
002827 


{ 


Info DataSeg(error, SELF.dataSegment.refNum[ newSegments], dsInfo); 
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resize the new last segment} 
ewSegSize := newSize - (maxSegSize*(newSegments-1)); 


{total doc size - size of all segments before last one} 


F error > 0 THEN 
ABCBreak('SetSegSize: Info Dataseg', error); 


WITH dsInfo DO 


! 
| 


{ 


END; 
{$lFC fTr 
END; 
{$S SgABCres} 


BEGIN 
Sched Class(sched_ err, FALSE); 
Size Dataseg(error, SELF.dataSegment.refnum[ newSegments] 


newSegSize-mem size, temp, newSegSize-disc_size, temp); 


Sched Class(sched_err, TRUE); 
END; 


$1 FC fDbgABC} 
F fExperimenting THEN 
BEGIN 
WriteLn('In SetSegSize: newSize=', newSize:1, ' newSegments=', newSegments: 1); 
WITH dsInfo DO 
WriteLn('newSegSize=',newSegSize:1, ' mem size=', memsize:1, 
' disc_size=', disc_size:1); 
END; 
$ENDC} 


F error > 0 THEN 
BEGIN 
{$1 FC fDbgABC} 


WriteLn('In SetSegSize: newSize=', newSize:1, ' newSegments=', newSegments: 1); 


WITH dsInfo DO 


WriteLn('newSegSize=',newSegSize:1, ' mem size=', memsize:1, 


' disc_size=', disc_size:1); 
{$ENDC} 
ABCBreak('In TDocManager.SetSegSize: Size Dataseg', error); 
END 


LSE 
BEGIN 
docSize := newSize 
numSegments := newSegments; 
ND; 


ace}EP: {$ENDC} 
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002828 {$S SgABCcl d} 

002829 PROCEDURE {TDocManager. }Suspend{( VAR error: INTEGER) }; 

002830 LABEL 1; 

002831 VAR lastSegClosed: INTEGER 

002832 osErr: INTEGER; 

002833 (*********** THESE VARIABLES ARE NEEDED ONLY IF SUSPEND 1S ABORTABLE 

002834 vol umePrefix: TFil ePath; 

002835 ldsn: INTEGER; 

002836 dsPat hname: Pat hName; 

002837 dsRef num: INTEGER; 

002838 me mOr d: LONGI NT; 

002839 reopenedSeg: INTEGER 

002841 BEGIN 

002842 {$I1FC fTrace}BP(7); {$ENDC} 

002843 {$1 FC fDbgABC} 

002844 [F SELF <> boundDocument THEN 

002845 ABCBreak('Suspend not-bound document', error); 

002846 {$ENDC} 

002847 

002848 SELF. dataSegment. preludePtr*.docDirectory. window := SELF. window; {In case it somehow changed} 
002849 

002850 error := 0; {*** error return here not very meaningful yet ***} 
002851 

002852 FOR lastSegClosed := 1 TO SELF. dataSegment. prel udePtr*. numSegments DO 
002853 BEGIN 

002854 Close Dataseg(osErr, SELF.dataSegment.refnum[| astSegCl osed] ) 
002855 LatestError(osErr, error) 

002856 SELF. dataSegment.refnum[lastSegClosed] := -1; 

002857 

002858 (********** DOES | T MAKE ANY SENSE FOR SUSPEND TO BE ABORTABLE 227? ********¥x 
002859 IF process. AbortRequest THEN 

002860 BEGIN 

002861 volumePrefix := SELF.files.volumePrefix: 

002862 FOR reopenedSeg := 1 TO lastSegClosed DO 

002863 BEGIN 

002864 Idsn := reopenedSeg + docldsn-1; 

002865 dsPathname := CONCAT(volumePrefix, suspendSuffix[reopenedSeg] ) 
002866 Open _DataSeg(osErr, dsPathname, dsRefnum, memOrd, Idsn); 
002867 LatestError(osErr, error); 

002868 IF osErr <= 0 THEN 

002869 BEGIN 

002870 SELF. dataSegment.refnum[reopenedSeg] := dsRefnum 
002871 SetAccess DataSeg(osErr, dsRefnum, FALSE); {Make writeable} 
002872 IF osErr > 0 THEN 

002873 ABCBreak('ReopenDatasegs, SetAccess DataSeg', osErr); 
002874 END 

002875 ELSE 
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002876 GOTO 1; 

002877 END; 

002878 IF error <= 0 THEN 

002879 error := erAborted 

002880 GOTO 1; 

002881 END; 

002883 END; 

002884 SELF. dataSegment.changes := 0 

002885 boundDocument := NIL; 

002886 1: {$IFC fTrace}EP; {$ENDC} 

002887 END; 

002888 {$S SgABCres} 

002889 

002890 

002891 {$S SgABCcl d} 

002892 PROCEDURE {TDocManager. }Unbi nd; 

002893 VAR error: INTEGER 

002894 i: I NTEGER; 

002895 BEGIN 

002896 {$1FC fTrace}BP(7); {$ENDC} 

002897 IF SELF = boundDocument THEN 

002898 BEGIN 

002899 (***** See how things work without this check 

002900 {$1 FC fDbgABC} 

002901 IF SELF = currentDocument THEN 

002902 ABCBreak('Unbind currentDocument', ORD( SELF) ) 
002903 {$ENDC} 

002904 *****) 

002905 

002906 FOR i := 1 TO SELF.dataSegment. preludePtr*. numSegments DO 
002907 BEGIN 

002908 Unbind DataSeg(error, SELF.dataSegment.refnum[i]); 
002909 IF error > 0 THEN 

002910 ABCBreak('Unbind DataSeg', error) 
002911 END; 

002912 

002913 boundDocument := NIL; 

002914 END; 

002915 {$I1FC fTrace}EP; {$ENDC} 

002916 END; 

002917 

002918 

002919 {$$ sRes} 

002920 FUNCTION {TDocManager. }}WindowWthid{(wmgrlD: TWindowl D): TWindow}; 
002921 BEGIN 

002922 {$I1FC fTrace}BP(7); {$ENDC} 

002923 [F SELF. window. wmgrlD = wmgrlD THEN 
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002924 Wi ndowWthid := SELF. window 
002925 ELSE 

002926 WindowWthid := NIL; 

002927 {$I1FC fTrace}EP; {$ENDC} 

002928 END: 

002929 

002930 

002931 {$8 SgABCi ni } 

002932 END; 

002933 

002934 

002935 METHODS OF TCli pboard 

002936 

002937 

002938 {$8 SgABCi ni } 

002939 FUNCTION {TClipboard. }CREATE{(object: TObject; heap: THeap): TClipboard}; 
002940 BEGIN 

002941 {$I1FC fTrace}BP(7); {$ENDC} 

002942 IF object = NIL THEN 

002943 object := NewObject(heap, THI SCLASS) 
002944 SELF := TClipboard(TDocManager.CREATE(object, heap, '--CLIPBOARD')); 
002945 WITH SELF DO 

002946 BEGIN 

002947 hasView := FALSE; 

002948 hasPicture := FALSE; 

002949 hasUniversal Text := FALSE: 
002950 haslcon := FALSE; 

002951 cuttingTool := 0; 

002952 cuttingProcessID := 0 

002953 clipCopy := NIL; 

002954 END; 

002955 {$1FC fTrace}EP; {$ENDC} 

002956 END; 

002957 {$S SgABCres} 

002958 

002959 

002960 {$1 FC fDebugMet hods} 

002961 {$S SgABCdbg} 

002962 PROCEDURE {TClipboard. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
002963 BEGIN 

002964 TDocManager. Fiel ds( Field) 

002965 Field('hasView: BOOLEAN' ) 

002966 Field('hasPicture: BOOLEAN'); 
002967 Field('hasUniversal Text: BOOLEAN’ ) 
002968 Field('haslcon: BOOLEAN' ) 

002969 Field('cuttingTool: LONGI NT') 
002970 Field('cuttingProcessID: LONGI NT' ) 
002971 Field('clipCopy: TFileScanner;'); 
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002972 END; 

002973 {$S SgABCres} 

002974 {$ENDC} 

002975 

002976 {$$ sCut} 

002977 PROCEDURE {TClipboard. }AboutToCut; 

002978 BEGIN 

002979 {$IFC fTrace}BP(7); {$ENDC} 

002980 InheritScrap( TRUE); 

002981 {$I1FC fTrace}EP; {$ENDC} 

002982 END; 

002983 

002984 

002985 {$S sCut} 

002986 PROCEDURE {TClipboard. }Begi nCut; 

002987 LABEL 1; 

002988 

002989 VAR heap: THeap; 

002990 wi ndow: TWi ndow 

002991 panel: TPanel; 

002992 view: TVi ew 

002993 selection: TSelection; 

002994 error: INTEGER; 

002995 BEGIN 

002996 {$IFC fTrace}BP(7); {$ENDC} 

002997 1F boundClipboard = NIL THEN 

002998 boundClipboard := SELF 

002999 ELSE 

003000 ABCBreak('BeginCut: Clipboard already bound', 0) 
003001 

003002 EraseScrapData(error) 

003003 IF error > 0 THEN 

003004 BEGIN 

003005 ABCBreak('EraseScrapData', error); 
003006 BackOut Of Scrap; 

003007 {need to put up alert that cut was not put into scrap and pass this info back up the ladder} 
003008 GOTO 1; 

003009 END; 

003010 

003011 {Obtain write access} 

003012 Start PutScrap(error); 

003013 IF error > 0 THEN 

003014 BEGIN 

003015 ABCBreak('StartPutScrap', error); 
003016 BackOut Of Scrap; 

003017 {need to put up alert that cut was not put into scrap and pass this info back up the ladder} 
003018 GOTO 1; 

003019 END; 
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003020 
003021 
003022 
003023 
003024 
003025 
003026 
003027 
003028 
003029 
003030 
003031 
003032 
003033 
003034 
003035 
003036 
003037 
003038 
003039 
003040 
003041 
003042 
003043 
003044 
003045 
003046 
003047 
003048 
003049 
003050 
003051 
003052 
003053 
003054 
003055 
003056 
003057 
003058 
003059 
003060 
003061 
003062 
003063 
003064 
003065 
003066 
003067 


1: 


END; 


{$$ 
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{Find out where the Clipboard heap is} 
heap := POI NTER( ORD( hzOf Scrap) ) 
SELF.docHeap := heap; 


{Create a standard window onto the Clipboard} 
window := SELF. NewWindow( heap, ORD(scrapFolder)); 
SELF. window := window 


panel := TPanel. CREATE(NIL, heap, window, 0, 0, [aScroll, aSplit], [aScroll, aSplit]); 


{Create a dummy view to be replaced by the application's view} 
view := panel. NewStatusView(NIL, zeroLRect); 


clipPrintPref := boundDocument. dataSegment. preludePtr%. print Pref; 
{$IFC fTrace}EP; {$ENDC} 
sPaste} 
PROCEDURE {TClipboard. }Bind 
VAR which: ScrapType; 
what: TH; 


BEGI 


docDirectory: TDocDirectory; 
olderVersion: BOOLEAN 
newer Version: BOOLEAN 
error: INTEGER; 


PROCEDURE CopyScrap; 
VAR aFile: TFile; 
fs: TFil eScanner; 
dsi nfo: DsI nf oRec; 


aFile := TFile.CREATE(NIL, mainHeap, 'TKScrapCopy', ''); 
fs := aFile. Scanner; 
SELF.clipCopy := fs; 
Info _Dataseg(error, DSegOfScrap, dsinfo); 
{$1 FC fDbgABC} 
1F error > 0 THEN 
ABCbreak('CopyScrap: error fromInfo Dataseg', error); 
{$ENDC} 


WITH dsInfo DO 
fs.XferSequential(xWrite, Ptr(AddrOfScrapDSeg), mem size) 
END; 
N 
{$I FC fTrace}BP(7); {$ENDC} 
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003068 
003069 
003070 
003071 
003072 
003073 
003074 
003075 
003076 
003077 
003078 
003079 
003080 
003081 
003082 
003083 
003084 
003085 
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003089 
003090 
003091 
003092 
003093 
003094 
003095 
003096 
003097 
003098 
003099 
003100 
003101 
003102 
003103 
003104 
003105 
003106 
003107 
003108 
003109 
003110 
003111 
003112 
003113 
003114 
003115 
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IF boundClipboard <> SELF THEN 
BEGIN 
1F boundClipboard <> NIL THEN 
boundCli pboard. Unbi nd 
boundClipboard := SELF; 


{Open the clipboard data segment } 
StartGetScrap(error); 
1F error > 0 THEN 
BEGIN 
ABCBreak('StartGetScrap', error); 
BackOut Of Scrap 


{need to put up alert that scrap cannot be bound and pass this info back up the | adder} 


END 


ELSE 
BEGIN 
{Obtain write access} 
SetAccess DataSeg(error, DSegOfScrap, FALSE) 
IF error > 0 THEN 
ABCBreak('SetAccess DataSeg', error); 


{Find out what is there to be pasted} 
Get Scrap( which, what); 


SELF. window := NIL; 


{$1FC LibraryVersion > 20} 


{$ENDC} 


(ee) 
ee) 


IF scrapProcess = myProcess|ID THEN 
1F which = scrapRef THEN 
BEGIN 
which := tool KitType; 
what := Pointer(Ord(GetFldrRefCon(scrapFolder))); 
END; 


1F which = tool KitType THEN 
BEGIN 
docDirectory := POI NTER( ORD( what) ) 


IF scrapProcess <> myProcessID THEN {Don't waste time checking if | put it there myself} 
IF NeedConversi on(docDirectory.classWorld, olderVersion, newerVersion) THEN 


BEGIN 
CopyScrap; 


{*** Should defer until app likes selection class ***} 


(*** ClaimScrap; ***) (***) 


Convert Heap( POI NTER( ORD(HzOf Scrap)), docDirectory.classWorld) 


docDirectory. Adopt; (***) 
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003116 END; 

003117 (**) 

003118 SELF. window := docDirectory. window 
003119 END; 

003120 

003121 {Record attributes of the clipboard data that the application might want to inquire about} 
003122 SELF. Inspect; 

003123 END; 

003124 END; 

003125 {$I1FC fTrace}EP; {$ENDC} 

003126 END; 

003127 

003128 

003129 {$S sCut} 

003130 PROCEDURE {TClipboard. }Commi t Cut; 

003131 BEGIN 

003132 {$I1FC fTrace}BP(7); {$ENDC} 

003133 AcceptI nherit Scrap; 

003134 {$1FC fTrace}EP; {$ENDC} 

003135 END; 

003136 

003137 

003138 {$8 sCut} 

003139 PROCEDURE {TClipboard. }EndCut; 

003140 VAR window: TWi ndow 

003141 clipSel: TSel ection; 

003142 docDirectory: TDocDirectory; 

003143 error: INTEGER; 

003144 BEGIN 

003145 {$I1FC fTrace}BP(7); {$ENDC} 

003146 window := SELF. window 

003147 clipSel := window. selectPanel.sel ection; 
003148 

003149 IF clipSel. kind = nothingKind THEN 

003150 BEGIN 

003151 {$1 FC fDbgABC} 

003152 ABCBreak('No selection in Clipboard at EndCut', 0); 
003153 {$ENDC} 

003154 BackOut Of Scrap; 

003155 {need to put up an alert and pass info up the | adder} 
003156 END 

003157 ELSE 

003158 BEGIN 

003159 {Display the Clipboard} 

003160 PushFocus; 

003161 wi ndow. Focus 

003162 window. Refresh([rErase, rFrame, rBackground, rDraw], hNone) 
003163 PopFocus; 
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003164 

003165 {Inform others of what TWindow is there to be pasted} 
003166 docDirectory := TDocDirectory. CREATE(NIL, SELF.docHeap, window, myWorl d) 
003167 PutScrap(tool KitType, POINTER(ORD(docDirectory)), error); 
003168 

003169 {Record attributes of the clipboard data that the application might want to inquire about} 
003170 SELF. Inspect; 

003171 

003172 {Relinquish write access} 

003173 EndPutScrap(error); 

003174 1F error > 0 THEN 

003175 ABCBreak('EndPutScrap', error); 

003176 END; 

003177 

003178 SELF. window := NIL; 

003179 boundClipboard := NIL; 

003180 {$I1FC fTrace}EP; {$ENDC} 

003181 END; 

003182 

003183 

003184 {$$ sCldil nit} 

003185 PROCEDURE {TClipboard. }Inspect 

003186 VAR which: ScrapType 

003187 what: TH; 

003188 pic: Pi cHandle: 

003189 BEGIN 

003190 {$I1FC fTrace}BP(7); {$ENDC} 

003191 {$H-} SELF.docHeap := POINTER(ORD(HzOfScrap)); {$H+} 

003192 GetScrap( which, what) 

003193 SELF. hasView := which = tool KitType; 

003194 {$H-} GetGrScrap(pic); {$H+} 

003195 SELF. hasPicture := pic <> NIL; 

003196 SELF. hasUniversal Text := (scrapCs IN currScrapSet); 
003197 {$lFC LibraryVersion > 20} 

003198 SELF. haslcon := which = scrapRef 

003199 {$ENDC} 

003200 SELF. cuttingProcessID := scrapProcess 

003201 {$H-} SELF. cuttingTool := Tool OfProcess(scrapProcess); {$H+} 
003202 {$I1FC fTrace}EP; {$ENDC} 

003203 END: 

003204 

003205 

003206 {$S SgABCcl d} 

003207 PROCEDURE {TClipboard. }Publicize 

003208 VAR window: TW ndow 

003209 panel: TPanel; 

003210 pane: TPane; 

003211 vi ewExtentLRect: LRect; 
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info: Wi ndowl nfo; 
picLlRect: LRect; 
tempHeap: THeap; 
picRect: Rect; 
tempPad: TPad; 

Pi cHandle: 
error: INTEGER; 


{$1 FC fTrace}BP(7); {$ENDC} 
IF scrapProcess = myProcessID THEN 


BEGIN 
SELF. Bind: 


window := SELF. window 
1F window <> NIL THEN {LSR} 


BEGIN {LSR} 

panel := TPanel (window. panels. First); 

pane := TPane( panel. panes. First); 

viewExtentLRect := window.select Panel. view. extentLRect; 


{Let the Window Manager have a picture to display while inactive [if open] } 
Get Wi ndl nfo( POI NTER( window. wmgr1D), info); 
IF info. visible THEN 

window. StashPicture(hNone); 


{Let others have a picture to paste} 

noPad. Rect ToLRect(hugeRect, picLRect); 

IF SectLRect(viewExtentLRect, picLRect, picLRect) AND NOT EmptyLRect(picLRect) THEN 
BEGIN 
Get Heap(tempHeap); 
Set Heap( POI NTER( ORD( HzOf Scrap) )); 


{Before calling Focus, set up everything for unclipped drawing of the view} 

tempPad := TPad. CREATE(NIL, mainHeap, hugeRect, picLRect, screenRes, 
screenRes, thePort); 

tempPad. LRectToRect(picLRect, picRect); 

Rect Rgn(altVisRgn, picRect); 

useAltVisRgn := TRUE; { enable clipping to whole picture } 


{Focus on the Clipboard} 

PushFocus; 

tempPad. Focus; 

focusArea := NIL; {To trap illegal attempts to Push/PopFocus during 
TVi ew. Draw} 


{Generate the Universal Picture} 
pic := OpenPicture(picRect); 
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003260 genClipPic := TRUE; { enable putting comments into picture } 
003261 PicComment(cPicGeDwg, 0, NIL); { needed for pasting into LisaDraw } 
003262 PicGrpBegi n; { every LisaDraw picture from other apps is a group } 
003263 panel. view. Draw; { tell the application to draw now } 
003264 PicGrpEnd; 

003265 

003266 ClosePicture; 

003267 

003268 {Put it in the Clipboard} 

003269 PutGrScrap(pic, error) 

003270 IF error > 0 THEN 

003271 ABCBreak('PutGrScrap', error) 

003272 

003273 {Generate the Universal Text} 

003274 panel. view. CreateUniversal Text; 

003275 

003276 {Unravel } 

003277 genClipPic := FALSE; { disable putting comments into picture } 
003278 useAltVisRgn := FALSE; { disable clipping to whole window } 
003279 PopFocus; 

003280 tempPad. Free 

003281 Set Heap(tempHeap) ; 

003282 END; 

003283 END; {LSR} 

003284 

003285 SELF. Unbi nd; 

003286 END; 

003287 {$I1FC fTrace}EP; {$ENDC} 

003288 END; 

003289 

003290 

003291 {$S sPaste} 

003292 PROCEDURE {TClipboard. }Unbi nd 

003293 VAR error: INTEGER 

003294 

003295 PROCEDURE RestoreScrap; 

003296 VAR fs: TFileScanner 

003297 BEGIN 

003298 fs := SELF.clipCopy; 

003299 IF fs <> NIL THEN 

003300 BEGIN 

003301 fs. XferRandom( xRead, Ptr(AddrOfScrapDSeg), fs.actual, fAbsolute, 0) 
003302 fs. Free; 

003303 SELF.clipCopy := NIL; 

003304 END; 

003305 END; 

003306 

003307 BEGIN 
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003308 {$I1FC fTrace}BP(7); {$ENDC} 

003309 [F SELF = boundClipboard THEN 

003310 BEGIN 

003311 RestoreScrap; 

003312 

003313 {$1 FC fDbgABC} 

003314 1F SELF = currentDocument THEN 
003315 ABCBreak('TClipboard. Unbind currentDocument', ORD( SELF) ) 
003316 {$ENDC} 

003317 

003318 boundClipboard := NIL; 

003319 

003320 {Relinquish access} 

003321 SELF. window := NIL; 

003322 EndGetScrap(error); 

003323 

003324 1F error > 0 THEN 

003325 ABCBreak('EndGetScrap', error); 
003326 END; 

003327 {$I1FC fTrace}EP; {$ENDC} 

003328 END; 

003329 

003330 

003331 {$$ sCut} 

003332 FUNCTION {TClipboard. }UndoCut{: BOOLEAN}; 
003333 VAR clipErr: INTEGER 

003334 BEGIN 

003335 {$I1FC fTrace}BP(7); {$ENDC} 

003336 Undol nheritScrap(clipErr); 

003337 SELF. Inspect; {so app can inquire} 
003338 

003339 (* IF (clipErr <= 0) AND SELF. hasView THEN * WRONG BECAUSE SELF. window MAY BELONG TO ANOTHER TK APP * 
003340 BEGIN 

003341 SELF. Bind: 

003342 SELF. window. Resize(FALSE); {in case clipboard resized between the cut and the undo-cut} 
003343 SELF. Unbi nd; 

003344 END; 

003345 *) 

003346 UndoCut := clipErr <= 0; 

003347 {$I1FC fTrace}EP; {$ENDC} 

003348 END; 

003349 

003350 

003351 {$8 SgABCi ni } 

003352 END; 

003353 

003354 


003355 METHODS OF TCommand 
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{$$ sCommand} 
FUNCTION {TCommand. }CREATE{(object: TObj ect; 
itslmage: TI mage; 
VAR cmdPhase: TCmdPhase 
BEGIN 
{$1 FC fTrace}BP( 6); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF : = TCommand( object); 


WITH SELF DO 
BEGIN 
cmdNumber := itsCmdNumber 
image := itsl mage; 
undoable := isUndoable 
doing := FALSE; 
revelation := itsRevel ation; 
FOR cmdPhase := doPhase TO redoPhase 
BEGIN 
unHiliteBefore[cmdPhase] := TRUE; 
hiliteAfter[cmdPhase] := TRUE; 
END; 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$8 SgABCdbg} 


PROCEDURE {TCommand. }Fields{( PROCEDURE Field(nameAndType 


BEGIN 
Field('cmdNumber: | NTEGER' ) 
Field('image: Tl mage'); 
Field('undoable: BOOLEAN'); 
Field('doing: BOOLEAN' ) 
Field('revelation: Byte') 


heap: THeap; itsCmdNumber: TCmdNumber; 
isUndoable: BOOLEAN; itsRevelation: TRevelation): TCommand}; 


DO 


§255))}; 


Field('unHiliteBefore: ARRAY[0..2] OF BOOLEAN' ) 
Field('hiliteAfter: ARRAY[0..2] OF BOOLEAN'); 


Field(''); 
END; 
{$S SgABCres} 
{$ENDC} 


{$$ sCommand} 
PROCEDURE {TCommand. }Commit; 
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C fTrace}BP( 7); {$ENDC} 
C fTrace}EP: {$ENDC} 


ans 
1 
mn - 


{$S sFilter} 
PROCEDURE {TCommand. }EachVirtual Part{( PROCEDURE DoToObject(filteredObj: TObject))}; 


PROCEDURE DoToFilteredObject(actual Obj: TObject); 
BEGIN 

SELF. FilterAndDo( actual Obj, DoToObj ect); 
END; 


BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
IF SELF.image <> NIL THEN 
SELF. i mage. EachActual Part (DoToFilteredObj ect) 
ELSE 
current Window. EachActual Part(DoToObj ect); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sFilter} 
PROCEDURE {TCommand. }FilterAndDo{(actual Obj: TObject; PROCEDURE DoToObject(filteredObj: TObj ect) )}; 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
DoToObj ect (actual Obj); 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$S sCommand} 
PROCEDURE {TCommand. }Perform{(cmdPhase: TCmdPhase) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$S SgABCi ni } 
END; 
{$$ SgABCres} 


METHODS OF TCutCopyCommand; 
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{$$ sCut} 
FUNCTION {TCutCopyCommand. }CREATE{(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itslmage: Tlmage; isCutCmd: BOOLEAN): TCutCopyCommand}; 
BEGIN 
{$I1FC fTrace}BP(6); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TCutCopyCommand(TCommand. CREATE(object, heap, itsCmdNumber, itsIl mage, TRUE, revealAll)); 
SELF.isCut := isCutCmd 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$S SgABCdbg} 
PROCEDURE {TCutCopyCommand. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 
SUPERSELF. Fields( Field); 
Field('isCut: BOOLEAN’ ) 
Field(''); 
END; 
{$S SgABCcl d} 
{$ENDC} 


{$$ sCut} 
PROCEDURE {TCutCopyCommand. }Comni t; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
clipboard. Commi t Cut; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Override} 
PROCEDURE {TCutCopyCommand. }DoCutCopy{(clipSelection: TSelection; deleteOriginal: BOOLEAN; 
cmdPhase: TCmdPhase) }: 


N 
{$I FC fTrace}BP(7); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 


{$S sCut} 
PROCEDURE {TCutCopyCommand. }Perform{(cmdPhase: TCmdPhase) }; 
BEGIN 

{$I FC fTrace}BP(7); {$ENDC} 
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CASE cmdPhase OF 
doPhase: 
BEGIN 
clipboard. About ToCut; 
clipboard. Begi nCut 
SELF. DoCutCopy(clipboard. window. selectPanel.selection, SELF.isCut, cmdPhase) 
clipboard. EndCut; 
END; 
undoPhase: 
BEGIN 
IF SELF.isCut THEN 
BEGIN 
1F NOT clipboard. hasView THEN 
ABCbreak('undoing Cut but clipboard has no view’, 0) 
ELSE 
BEGIN 
clipboard. Bind 
IF clipboard. window = NIL THEN 
ABCbreak('undoing Cut but clipboard. window = NIL', 0) 
ELSE 
SELF. DoCut Copy(clipboard. window. selectPanel.selection, TRUE, cmdPhase); 
clipboard. Unbi nd; 
END; 
END 
ELSE 
SELF. DoCutCopy( NIL, FALSE, cmdPhase); 
1F NOT clipboard. UndoCut THEN 
BEGIN 
{$l FC f DbgABC} 
ABCbreak('clipboard.UndoCut returns FALSE', 0); 
{$ENDC} 
END; 
END; 
redoPhase: 
BEGIN 
1F NOT clipBoard. UndoCut THEN 
BEGIN 
ABCbreak('clipboard.UndoCut returns FALSE', 0); 
END 
ELSE 
BEGIN 
clipboard. Bind; 
1F NOT clipboard. hasView THEN 
ABCbreak('re-doing Cut/Copy but clipboard has no view’, 0) 
ELSE 
SELF. DoCutCopy(clipboard. window.selectPanel.selection, SELF.isCut, cmdPhase) 
clipboard. Unbind 
END; 
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END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S SgABCi ni } 
END; 
{$$ SgABCres} 


METHODS OF TPasteCommand; 


{$$ sPaste} 
FUNCTION {TPasteCommand. }CREATE{(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itslmage: Tl mage): TPasteCommand}; 
BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TPasteCommand(TCommand. CREATE(object, heap, itsCmdNumber, itsl mage, TRUE, reveal All)) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Override} 
PROCEDURE {TPasteCommand. }DoPaste{(clipSelection: TSelection; pic: PicHandle; cmdPhase: TCmdPhase) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 


{$$ sPaste} 
PROCEDURE {TPasteCommand. }Perform{(cmdPhase: TCmdPhase) }: 


VAR window: TW ndow 
pic: Pi cHandl e; 
selection: TSelection; 

BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 
CASE cmdPhase OF 
doPhase, redoPhase 
1F NOT (clipboard. hasPicture OR clipboard. hasView OR clipboard. hasUniversal Text) THEN 
IF currScrapSet = [] THEN 
process. Stop( phNoCli p) 
ELSE 
process. Stop( phUnkCl i p) 
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ELSE 
BEGIN 
clipboard. Bind; 
{$H-} GetGrScrap(pic); {$H+} 


window := clipboard. window 
1F window = NIL THEN 
SELF. DoPaste(NIL, pic, cmdPhase) 
ELSE 
BEGIN 
selection := window.selectPanel.selection; 
IF selection. Class = cSelection THEN 
SELF. DoPaste(NIL, pic, cmdPhase) 
ELSE 
SELF. DoPaste(selection, pic, cmdPhase) 
END; 


clipboard. Unbind 
END; 
undoPhase: 

SELF. DoPaste(NIL, NIL, cmdPhase) 


END; 
{$I1FC fTrace}EP; {$ENDC} 


{$5 SgABCi ni } 
END; 
{$$ SgABCres} 


File -- Lines: 3624 Characters: 116410 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


{INCLUDE FILE UABC3 -- IMPLEMENTATION OF UABC} 
{Copyright 1983, 1984, Apple Computer, Inc. } 


{Tl mage-TVi ew- TPagi nat edVi ew- TPageVi ew- TPri nt Manager- THeadi ng- TSel ecti on} 


METHODS OF TI mage; 


{$S SgABCi ni } 
FUNCTION {Tl mage. }}CREATE{(object: TObj ect 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
:= Tl mage( object); 


heap: THeap; 


SELF 


WITH SELF DO 
BEGIN 
extentLRect := itsExtent; 
view := itsView 
all owMouseOutside := 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


FALSE; 


{$1 FC fDebugMet hods} 

{$S SgABCdbg} 

PROCEDURE {TI mage. }Fields{( PROCEDURE Fiel d( nameAndType 

BEGIN 
Field('extentLRect: LRect'); 
Field('view: TView'); 
Field(' all owMouseOutsi de: 
Field(''); 

END; 

{$S SgABCres} 

{$ENDC} 


$255) )}; 


BOOLEAN' ); 


{$$ Override} 
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FUNCTION {Tl mage. }CursorAt{(mouseLPt: LPoint): TCursor}; 


BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
CursorAt := NoCursor; 


{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ Override} 
PROCEDURE {TI mage. }Draw 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S Override} 
PROCEDURE {Tl mage. }EachActual Part {( PROCEDURE DoToObj ect(filteredObj: TObject))}; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
SELF. view. panel. window. EachActual Part (DoToObj ect); 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$S sFilter} 
PROCEDURE {TI mage. }EachVirtual Part {(PROCEDURE DoToObject(filteredObj: TObj ect))}; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
SELF. view. panel. window. FilterDispatch(NIL, SELF, DoToObj ect); 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$S sFilter} 


PROCEDURE {Ti mage. }FilterAndDo{(actual Obj: TObject; PROCEDURE DoToObj ect(filteredObj: 


BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
SELF. view. panel. window. FilterDispatch(actual Obj, SELF, DoToObj ect); 
{$I1FC fTrace}EP; {$ENDC} 


END; 

{$$ sCldl nit} 

PROCEDURE {Tl mage. }HaveVi ew{(view: TView)}; 
BEGIN 


{$I FC fTrace}BP(7); {$ENDC} 
SELF.view:= view; {fancier subclasses do fancier things here} 


TObj ect))}; 
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{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
FUNCTION {Tl mage. }Hit{(mouseLPt: LPoint): BOOLEAN}; 
BEGIN 

{$1FC fTrace}BP( 3); {$ENDC} 

Hit := LRectHasLPt(SELF.extentLRect, mouseLPt); 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TI mage. }I nvali date; 
BEGIN 

{$IFC fTrace}BP( 3); {$ENDC} 

IF thePad <> NIL THEN 

thePad. Inval LRect (SELF. extentLRect); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Override} 
FUNCTION {Tl mage. }LaunchLayoutBox{(view: TView): Tl mage}; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
LaunchLayoutBox := NIL; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {Tl mage. }OffSetBy{(deltaLPt: LPoint)}; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
{$H-} OffsetLRect(SELF.extentLRect, deltaLPt.h, deltaLPt.v); {$H+} 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {Tl mage. }OffSetTo{(newTopLeft: LPoint)}; 
VAR deltaLPt: LPoint; 
curTopLeft: LPoint; 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
curTopLeft := SELF. extentLRect.topLeft; 
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SetLPt(deltaLPt, newTopLeft.h - curTopLeft.h, newTopLeft.v - curTopleft.v); 
SELF. Of fsetBy(deltaLPt); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {Tl mage. }MouseMove{(mouseLPt: LPoint)}; 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 

[F SELF.view. panel <> NIL THEN 

SELF. view. panel.selection., MouseMove( mouseLPt); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sRes} 
PROCEDURE {Tl mage. }MousePress{(mouseLPt: LPoint)}; 
BEGIN 

{$1 FC fTrace}BP(7); {$ENDC} 

[F SELF.view. panel <> NIL THEN 

SELF. view. panel.selection. MousePress(mouseLPt); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TI mage. }MouseRel ease 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 

[F SELF.view. panel <> NIL THEN 

SELF. view. panel.selection, MouseRel ease 

{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TI mage. }MouseTrack{( mPhase: TMousePhase; mouseLPt: LPoint)}; 
VAR panel: TPanel 
window: TW ndow 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
panel := SELF. view. panel 
IF panel <> NIL THEN 
BEGIN 
IF NOT (panel.selection.canCrossPanels OR SELF. all owMouseOutside) THEN 
LRectHaveLPt(SELF.extentLRect, mouseLPt); 
window := panel. window 
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window. clickPanel := panel 
END; 


SELF.view.clickLPt := mouseLPt; {e.g., for Set Page Breaks use} 
CASE mPhase OF 
mPress: SELF. MousePress(mouseLPt) 
mMove: SELF. MouseMove( mouseLPt); 
mRel ease: BEGIN 
SELF. MouseMove( mouseLPt); 
wi ndow. Update( TRUE); 
SELF. MouseRel ease 
END; 
END; 
wi ndow. Update( TRUE); 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ Override} 
PROCEDURE {Tl mage. }ReactToPrinterChange 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 


{$$ Override} 
PROCEDURE {Tl mage. }RecalcExtent; 
BEGIN 

{$IFC fTrace}BP( 3); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 


{$$ sRes} 
PROCEDURE {TI mage. }Resize{(newExtent: LRect)}; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
SELF.extentLRect := newExtent; 
{$SIFC fTrace}EP; {$ENDC} 
END: 


{$S sRes} 
FUNCTION {Tl mage. }SeesSameAs{(image: Tl mage): BOOLEAN; DEFAULT}; {$} 
BEGIN 

{$1FC fTrace}BP( 3); {$ENDC} 

SeesSameAs := image = SELF; 
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{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCi ni} 
END; 


METHODS OF TView 


{$8 SgABCi ni } 

FUNCTION {TView. }CREATE{(o 
itsPrint Manager 
itsRes: Point; 

VAR screenPad: TPa 

BEGIN 


bject: TObject; heap: THeap; 
: TPrint Manager; 
isMainView: BOOLEAN): TView}; 
d; 


{$1 FC fTrace}BP(7); {$ENDC} 


NIL THEN 
: = NewObj ect 


IF object = 
obj ect 
SELF 


WITH SELF DO 
BEGIN 
view := SELF; 
panel := itsPanel 
printManager := its 
res := itsRes; 
clickLPt := itsExte 
fitPagesPerfectly 
{$H- } 
Set Pt(scroll PastEnd 
{$H+} 
END; 
SELF.isMainView := 
SELF.isPrintable 


is Ma 


screenPad 
SELF.screenPad := scree 
{$H- }SetLPt(SELF.stdScroll 


1F isMainView THEN 
BEGIN 


:= TView(Tl mage. CREATE( obj ect, 


:= TPad, CREATE( NIL, 


(heap, THISCLASS); 


heap, itsExtent, 


Print Manager; 


nt. topLeft; 


:= itsFitPagesPerfectly; 


, 60, 40); 


inView; 


nPad; 


(16 * SELF.res.h) DIV screenRes.h, 


itsPanel: 
itsDfltMargins: LRect 


heap, zeroRect, zeroLRect, screenRes, SELF.res 


itsPanel. HaveVi ew( SELF); 
IF itsPrintmanager <> NIL THEN 


itsPrintManager. I mit(SELF, itsDflt Margins) 
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TPanel; itsExtent: LRect; 
itsFitPagesPerfectl y: BOOLEAN 


NIL)); 


:= (itsPrintManager <> NIL) AND isMainView 


NIL); 


(11 * SELF.res.v) DIV screenRes.v); 
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SELF. ReactToPrinterChange 
END; 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCi ni } 

PROCEDURE {TView. }Free 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
1F SELF.isMainView THEN 

Free( SELF. print Manager); 

Free(SELF.screenPad); 
SUPERSELF. Free: 
{$IFC fTrace}EP; {$ENDC} 

END: 

{$S SgABCres} 


{$1 FC fDebugMet hods} 

{$8 SgABCdbg} 

PROCEDURE {TView. }Fields{( PROCEDURE Field(nameAndType: 

BEGIN 
Tl mage. Fields( Field); 
Field('panel: TPanel') 
Field('clickLPt: LPoint'); 
Field('printManager: TPrintManager'); 
Field('res: Point'); 
Field('screenPad: TPad') 
Field('fitPagesPerfectly: BOOLEAN' ) 
Field('isPrintable: BOOLEAN'); 
Field('isMainView: BOOLEAN' ) 
Field('stdScroll: LPoint'); 
Field('scroll PastEnd: Point'); 
Field(''); 

END; 

{$S SgABCres} 

{$ENDC} 


{$S SgABCpri } 
PROCEDURE {TView. }AddStri pOfPages{(vhs: VHSel ect) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
[F SELF. printManager <> NIL THEN 
SELF. pri ntManager. AddStri pOf Pages(vhs); 


$255) )}; 
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{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S sCl di nit} 
PROCEDURE {TView. }Bel nPanel {( panel: TPanel) }; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
SELF. panel := panel 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCcl d} 
PROCEDURE {TView. }CreateUni versal Text; 
BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sRes} 
FUNCTION {TView. }CursorAt{(mouseLPt: LPoint): TCursorNumber}; 
BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
CursorAt := arrowCursor 
{$SIFC fTrace}EP; {$ENDC} 
END; 
SgDRWres } 


FUNCTION {TView. }DoReceive{(selection: TSelection; I PtInView: LPoint): BOOLEAN}; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
DoReceive := FALSE; {Default is to refuse cross-panel drag} 
{$I1FC fTrace}EP; {$ENDC} 
END; 
SgABCres} 


{$S sStartup} 
FUNCTION {TView. }ForceBreakAt{(vhs: VHSelect; precedingLocation: LONGI NT; 
proposedLocation: LONGINT): LONGI NT}; 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
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ForceBreakAt := proposedLocation; {default is to accept the proposal; client can override} 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ sScroll} 
PROCEDURE {TView. }GetStdScroll{(VAR deltaLStd: LPoint)}; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
|F NOT SELF. panel. zoomed THEN 
deltaLStd := SELF.stdScrol 
ELSE 
WITH SELF. panel.zoomFactor DO 
{$H-} BEGIN 
deltaLStd.h: 
deltaLStd.v: 
{$H+} END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


Li ntOvrint( Lint Mull nt(ORD4(SELF.stdScroll.h), denominator. h), numerator.h); 
Li ntOvrint( Lint Mull nt(ORD4(SELF.stdScroll.v), denominator.v), numerator.v); 


{$S SgABCpri } 

FUNCTION {TView. }MaxPageToPrint{: LONGI NT}; 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
MaxPageToPrint := SELF. print Manager. breaks[v].size * SELF. print Manager. breaks[h].size 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$S sStartup} 

FUNCTION {TView. }NoSelection{: TSelection}; 

BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
NoSelection := TSelection,CREATE( NIL, SELF.Heap, SELF, nothingKind, zeroLPt); 
{$1FC fTrace}EP; {$ENDC} 

END; 


{$S sRes} 

FUNCTION {TView. }OKToDrawin{(IRectinView: LRect): BOOLEAN}; 

BEGIN 
{$1 FC fTrace}BP( 6); {$ENDC} 
OKToDrawin := FALSE; {The default is to assume the worst, unless the application overrides} 
{$IFC fTrace}EP; {$ENDC} 

END; 
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{$$ sCldil nit} 
PROCEDURE {TView. }React ToPrinterChange 
BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 
[F SELF. printManager <> NIL THEN 
SELF. pri ntManager. React ToPrinterChange 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S sStartup} 

PROCEDURE {TView. }RedoBreaks 

BEGIN 
{$I FC fTrace}BP(6); {$ENDC} 
IF SELF. printManager <> NIL THEN 

SELF. pri ntManager. RedoBreaks; 

{$I1FC fTrace}EP; {$ENDC} 

END; 


{$8 SgABCcl d} 
PROCEDURE {TView. }RemapManual Breaks {( 
FUNCTION NewBreakLocation(vhs: VHSelect; oldBreak: LONGI NT): LONGI NT) }; 
VAR print Manager: TPrint Manager 


ol dLoc: LONGI NT; 
newLoc: LONGI NT; 
ol di ndex: LONGI NT; 
vhs: VHSel ect; 


BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
printManager := SELF. print Manager 
IF printManager <> NIL THEN 
BEGIN 
print Manager. Cl ear PageBreaks( TRUE); 
FOR vhs := v TO h DO 
FOR oldindex := 1 TO printManager. breaks[vhs].size - 1 DO 


BEGIN 
oldLoc := TpLONGINT( print Manager. breaks[ vhs]. At(ol dl ndex) ) *; 
newLoc := - NewBreakLocation(vhs, ABS(oldLoc)); 


print Manager. breaks[vhs]. PutAt(oldindex, @newLoc); 


SELF. RedoBreaks; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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PROCEDURE {TView. }Resize{(newExtent: LRect) }; 


VAR s: 
pageBreak: 
vhs: 

ol dLimit: 

newLi mit: 

breakl ndex: 

breakArray: 
BEGIN 


TListScanner; 
LONGI NT; 
VHSel ect; 
LONGI NT; 
LONGI NT; 

| NTEGER; 
TArray; 


{$1FC fTrace}BP(9); {$ENDC} 
1F NOT (SELF.isMainView) OR NOT(SELF.isPrintable) THEN 
SUPERSELF. Resi ze( newExtent ) 


ELSE 
1F NOT Equal 
BEGIN 
FOR vhs 
BEGI 


oldLimit : 
newLimit : 


breakI ndex : 
breakArray 


LRect(SELF.extentLRect, newExtent) THEN 


:= v TO h DO 

N 

SELF. extentLRect. botRi ght. vh[ orthogonal [vhs] ]; 
newExtent. botRi ght. vh[ orthogonal [vhs]]; 


1; 
SELF. print Manager. breaks[ vhs] 


WHILE breakIl ndex <= breakArray.size DO 


END; 


BEGIN 
pageBreak := TpLONGI NT( breakArray. At(breakl ndex)) *; 
IF pageBreak = oldLimit THEN 
BEGIN 
{reset the end-of-view pagebreak to new limit} 
pageBreak := newLimit; 
breakArray. PutAt(breakl ndex, @pageBreak); 
END 


ELSE 
1F ABS(pageBreak) >= newLimit THEN 
{discard other now-too-big pagebreaks} 
BEGIN 
breakArray. Del At ( breakI ndex); 
breakI ndex := breakIndex - 1; 
END; 
breakIl ndex := breakIl ndex + 1; 
{ELSE pagebreak still valid; do nothing} 
END; 


SELF. extentLRect := newExtent; 
SELF. panel. Rescroll 


END; 


Apple 
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000524 {$I1FC fTrace}EP; {$ENDC} 

000525 END; 

000526 {$S SgABCres} 

000527 

000528 

000529 {$S SgABCcl d} 

000530 PROCEDURE {TView. }SetFunctionValue{(keyword: $255; VAR itsValue: $255) }; 
000531 BEGIN 

000532 {$1FC fTrace}BP( 6); {$ENDC} 

000533 StrUpperCased( @keyword) 

000534 

000535 IF keyword = varPage THEN {+SW+} 

000536 LI ntToStr(theMarginPad. pageNumber, @itsVal ue) 
000537 ELSE 

000538 1F keyword = varTitle THEN {+SW+} 

000539 SELF. panel. window. Get Titl e(itsVal ue) 

000540 

000541 {ELSE 

000542 IF keyword =.... *** this is where to add more predefined functions ***} 
000543 

000544 ELSE {didn't parse} 

000545 itsValue := keyword 

000546 {$I1FC fTrace}EP; {$ENDC} 

000547 END; 

000548 

000549 

000550 {$S sStartup} 

000551 PROCEDURE {TView. }Set Mi nViewSize{(VAR minLRect: LRect) }; 
000552 BEGIN 

000553 {$I1FC fTrace}BP(6); {$ENDC} 

000554 minLRect := SELF.extentLRect; {client may override this to inspect his view for other ideas} 
000555 {$I1FC fTrace}EP; {$ENDC} 

000556 END; 

000557 

000558 

000559 {$S SgABCi ni } 

000560 END; 

000561 {$8 SgABCres} 

000562 

000563 

000564 

000565 METHODS OF TPaginatedVi ew 

000566 

000567 

000568 {$S SgABCpri } 

000569 FUNCTION {TPaginatedView. }CREATE{(object: TObject; heap: THeap; itsUnpaginatedView: TVi ew) 
000570 : TPaginatedVi ew}; 
000571 VAR viewExtent: LRect; 
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BEGIN 


pgsPerRowStrip: INTEGER 

pgsPerCol Strip: INTEGER 

pageWi dth: LONGI NT; 

pageHei ght: LONGI NT; 

printerMetrics: TPrinterMetrics; 

pageLi st: TList; 

rowStri p: INTEGER; 

col Strip: INTEGER; 

pageOri gin: LPoi nt; 
{$I1FC fTrace}BP(7); {$ENDC} 
printerMetrics := itsUnpagi natedView. print Manager. printerMetrics 
pgsPerRowStrip := itsUnpagi natedView. print Manager. breaks[v].size 


pgsPerCol Strip := itsUnpagi natedView. print Manager. breaks[h].size 
WITH printerMetrics, paperRect DO 
BEGIN 
pageWdth := LintOvrint(LintMull nt(ORD4(right - left), itsUnpaginatedView. res. h) 
printerMetrics.res.h); 
pageHei ght: = LintOvrint(LintMull nt(ORD4(bottom- top), itsUnpaginatedView.res.v), 
printerMetrics.res.v); 
END; 


SetLRect(viewExtent, 0, 0, pgsPerRowStrip * ORD4(pageWdth), pgsPerCol Strip * ORD4( pageHei ght)); 


IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TPaginatedView(TView. CREATE(object, heap, itsUnpaginatedView. panel, viewExtent, 
itsUnpaginatedView. printManager, zeroLRect, FALSE, 
itsUnpaginatedView.res, FALSE) ) 


WITH SELF DO 
BEGIN 
unpagi natedView := itsUnpagi natedVi ew 
pageSize[h] := pageW dth; 
pageSize[v] := pageHei ght; 
workingl nMargins := FALSE; 
END; 


{$IFC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 

{$8 SgABCdbg} 

PROCEDURE {TPagi natedView. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 


TView. Fields( Field); 
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000620 Field('unPaginatedView: TView') 

000621 Field('pageSize: ARRAY[0..1] OF LONGINT'); 

000622 Field('workingl nMargins: BOOLEAN' ) 

000623 Field(''); 

000624 END; 

000625 {$S SgABCcl d} 

000626 {$ENDC} 

000627 

000628 

000629 {$S SgABCpri } 

000630 PROCEDURE {TPagi natedVi ew. }AddStri pOf Pages{(vhs: VWHSel ect) }; 
000631 VAR panel: TPanel 

000632 BEGI N 

000633 {$1FC fTrace}BP( 9); {$ENDC} 

000634 panel := SELF. panel 

000635 panel. Preview(mPrvwOff); {get back to main-view metrics in the panes} 
000636 {Don't refer to SELF after this, since Preview has deallocated me} 
000637 panel. view. print Manager. AddStri pOf Pages( vhs); 

000638 panel. Preview(mPrvwMargins); {creates fresh paginated view with correct info} 
000639 {$1FC fTrace}EP; {$ENDC} 

000640 END; 

000641 

000642 

000643 {$S SgABCpri } 

000644 PROCEDURE {TPaginatedView. }AdornPageOnScreen; {+SW+} {now using CONSTs to tune layout of pg numbers} 
000645 CONST 

000646 {$IFC LibraryVersion <= 20} 

000647 lrOffset = 10; 

000648 topOffset = 22; 

000649 bottom0ffset = 9; 

000650 

000651 lrOutset = 6; 

000652 topOutset = 4; 

000653 bottomOutset = 2; 

000654 {$ELSEC} 

000655 lrOffset = 10; 

000656 topOffset = 22; 

000657 bottom0ffset = 9; 

000658 

000659 lrOutset = 6; 

000660 topOutset = 1; {+SW+} 

000661 bottomOutset = 1; 

000662 {$ENDC} 

000663 VAR pgNum: $255; 

000664 r: Rect; 

000665 tempRect: Rect; 

000666 paper Rect: Rect; 

000667 contentRect: Rect; 
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000668 pat: pattern; 

000669 {$IFC LibraryVersion <= 20} 

000670 fl nfo: TFI nfo; 

000671 {$ELSEC} 

000672 fl nfo: Font nfo; 

000673 {$ENDC} 

000674 numberLength: INTEGER 

000675 print Manager: TPri nt Manager 

000676 

000677 PROCEDURE DistinguishScreenFeedback(theString: $255; h, v: INTEGER); 
000678 VAR box: Rect; 

000679 BEGIN 

000680 WITH box, flnfo DO 

000681 BEGIN 

000682 left := h - IrOutset; 

000683 right := h + StringWdth(theString) + IrOutset; 
000684 top :=v - ascent - leading - topOutset; 

000685 bottom:= v + descent + leading + bottomOutset; 
000686 END; 

000687 FillRoundRect(box, 10, 10, white);{*** These constants won't stand up under zooming! ***} 
000688 MoveTo(h, v) 

000689 DrawString(theString) 

000690 InvertRoundRect(box, 10, 10); 

000691 END; 

000692 BEGIN 

000693 {$I1FC fTrace}BP(7); {$ENDC} 

000694 printManager := SELF. unpagi natedVi ew. print Manager; 

000695 

000696 IF focusArea <> theMarginPad THEN {need to refocus onto the exterior...} 
000697 theMarginPad. Focus 

000698 

000699 {frame the overall page} 

000700 penNor mal 

000701 penMode(patOr); 

000702 penSi ze( 3, 2) 

000703 FrameLRect(print Manager. paperLRect); 

000704 

000705 {draw a very light-gray pattern everywhere in the margins} 
000706 theMarginPad. LRectToRect(printManager. paperLRect, paperRect) 
000707 RectRgn(padRgn, paperRect); 

000708 theMarginPad, LRectToRect( print Manager.contentLRect, content Rect) 
000709 RectRgn(scrRgniForDrawHdgs, content Rect); 

000710 DiffRgn(padRgn, scrRgnlForDrawHdgs, scrRgnlForDrawHdgs); 
000711 PenMode(patOr); 

000712 theMarginPad, LPatToPat( marginPattern, pat); 

000713 PenPat (pat); 

000714 Paint Rgn(scrRgnlForDrawHdgs) ; 

000715 
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000717 
000718 
000719 
000720 
000721 
000722 
000723 
000724 
000725 
000726 
000727 
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000730 
000731 
000732 
000733 
000734 
000735 
000736 
000737 
000738 
000739 
000740 
000741 
000742 
000743 
000744 
000745 
000746 
000747 
000748 
000749 
000750 
000751 
000752 
000753 
000754 
000755 
000756 
000757 
000758 
000759 
000760 
000761 
000762 
000763 
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1F NOT Equal Rect(theBodyPad. nonNull Body, theBodyPad.innerRect) THEN 
BEGIN 
RectRgn(scrRgnlForDrawHdgs, theBodyPad.innerRect); 
RectRgn(scrRgn2ForDrawHdgs, theBodyPad. nonNull Body); 
DiffRgn(scrRgnlForDrawHdgs, scrRgn2ForDrawHdgs, scrRgnlForDrawHdgs); 


{Both theBodyPad.innerRect & theBodyPad. nonNull Body are expressed in (0,0)-origined 
window coordinates; since we are focused on theMarginPad now, must offset the 
rgn by its origin. } 

WITH theMarginPad. origin DO 
{$H- } 

Of fsetRgn(scrRgnlForDrawHdgs, h, v); 
{$H+} 


thePad. SetPen(1limboPen); 
Pai nt Rgn(scrRgniForDrawHdgs); 
END; 


{Frame the content rectangle--normally directly abuts the margin} 
penNor mal 
penMode( pat Or); 
FrameRect(content Rect); 


{draw page numbers in corners} 
IntToStr(theMarginPad. pageNumber, @pgNum) 
Set QDTypeStyl e(cornerNumber Style); 
numberLength := StringWi dth( pgNum) 

r := paperRect; 

Get Font! nfo(flnfo); 

Di sti nguishScreenFeedback( pgNum, 
Di stinguishScreenFeedback( pgNum, 
Di sti nguishScreenFeedback( pgNum, 
Di sti nguishScreenFeedback( pgNum, 


.left + lrOffset, r.top + topOffset); 

.fight - numberLength - IlrOffset, r.top + topOffset) 

-fight - numberLength - IlrOffset, r. bottom - bottom0ffset); 
.left + lrOffset, r.bottom- bottomOffset); 


{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCpri } 
FUNCTION {TPaginatedView. }CursorAt{(mouseLPt: LPoint): TCursorNumber}; 
{later deal with cursor for margins} 
VAR unPagLPt: LPoint 
BEGIN 
{$IFC fTrace}BP( 9); {$ENDC} 
SELF. DepagifyLPoint(mouseLPt, unPagLPt); 
CursorAt := SELF. unpagi natedVi ew. CursorAt(unPagLPt) 
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{$I FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE {TPaginatedView. }DepagifyLPoint{(pagLPt: LPoint; VAR unPagLPt: LPoi nt) }; 
{Given a point in the paginated view, determine the nearest corresponding point in the unpaginated vi ew} 


VAR print Manager: TPri nt Manager 


meatLRect: LRect; {the portion of the page that displays a part of the main view} 
vhs: VHSel ect; 

breakArray: TArray {OF LONGI NT}; 

strip: I NTEGER; {the ordinal number of the strip containing the page} 
breakLocation: LONGI NT; {the coordinate of the start of the page} 

pageBreak: LONGINT; {the page break at the beginning of the page} 

next Break: LONGINT; {the page break at the end of the page} 

pageOri gin: LPoi nt; {the top left corner of the page, in the paginated view} 
strips: Point; {the strip numbers in each direction, stored as a Point} 


| Offset Pt: LPoi nt; {the top left corner of the meat rect of the page, in the main view} 


BEGIN 
{$1 FC fTrace}BP(7); {$ENDC} 
LRectHaveLPt(SELF.extentLRect, pagLPt); 


printManager := SELF. unpagi natedVi ew. print Manager; 
meatLRect := printManager.contentLRect 


FOR vhs := v TO h DO 
BEGIN 
breakArray := printManager. breaks[orthogonal [vhs] ]; 


{compute strip number} 
strip := Min(LIntDivlInt(pagLPt.vh[ vhs], SELF. pageSize[vhs]) + 1, 


breakArray. size); 


{compute breakLocation, being the location in the main view of the top-leftmost 


content point of the page in which our boy was found} 

IF strip = 1 THEN 

breakLocation := 0 
ELSE 

BEGIN 

pageBreak := TpLONGINT( breakArray. At(strip - 1))*; 

breakLocation := ABS( pageBreak) 

END; 


{recompute end of meatLRect (limbo boundary) } 
nextBreak := TpLONGINT(breakArray. At(strip))*; 


meatLRect.botRight.vh[vhs] := meatLRect.topLeft.vh[vhs] + ABS(nextBreak) - breakLocati on; 


{compute pageOrigin -- the location in the paginated view of the topleft corner of this page} 
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pageOrigin. vh[vhs] := Lint Mull nt(SELF. pageSize[vhs], strip - 1); 


{stuff strip and breakLocation into points for future reference} 


strips. vh[vhs] := strip; 
1O0ffsetPt.vh[ vhs] := breakLocation; 
END; 


{project the point into the (0,0)-origined space that the printManager rectangles are in} 


LPtMinusLPt(pagLPt, pageOrigin, pagLPt) 


LRectHaveLPt(meatLRect, pagLPt); {force it to meat rectangle} 


LPtMinusLPt(pagLPt, meatLRect.topLeft, pagLPt); {get offset frominner corner} 


LPtPlusLPt(pagLPt, lOffsetPt, unPagLPt); {project onto main view} 


{$I FC fTrace}EP; {$ENDC} 
END; 
PROCEDURE {TPagi natedVi ew. }DoOnPages{(focusOnl nterior: BOOLEAN 


firstRowStrip: INTEGER 
firstColStrip: INTEGER 


lastRowStrip: INTEGER 
lastCol Strip: INTEGER 
row: INTEGER; 
column: INTEGER; 
pageNumber: LONGI NT; 
1 Origin: LPoint; 
origin: Poi nt; 
anLRect: LRect; 


i ncomi ngPane: TPane 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
incomingPane := TPane(thePad); 
anLRect := thePad. visLRect; 
IF SectLRect(anLRect, SELF.extentLRect, anLRect) THEN 
{thanks for the lovely intersection}; 


IF EqualLRect(anLRect, zeroLRect) THEN 
BEGIN 
{$1 FC fTrace}EP; {$ENDC} 
EXI T( DoOnPages) ; 
END; 


pgsPerStrip := SELF. print Manager. breaks| 


PROCEDURE DoOnAPage) ) }; 
VAR pgsPerStrip: INTEGER; {pages per row-strip if pageRiseDirection 


h} 


orthogonal [SELF. print Manager. pageRiseDirection]].size 


WITH anLRect, SELF DO 
BEGIN 
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000860 {$H-} firstRowStrip := LI ntDivLI nt(topLeft.v, pageSize[v]) + 1; 

000861 firstCol Strip := LintDivLI nt(topLeft.h, pageSize[h]) + 1; 

000862 lastRowStrip := MIN(LIntDivLInt(botRight.v, pageSize[v]) + 1, 

000863 SELF. print Manager. breaks[h].size); 

000864 lastColStrip := MIN(LIntDivLInt(botRight.h, pageSize[h]) + 1, 

000865 SELF. print Manager. breaks[v].size); 

000866 {$H+} END; 

000867 

000868 PushFocus; 

000869 IF (theMarginPad. view <> SELF. unpaginatedView) OR (theMarginPad. port = printerPseudoPort) THEN 
000870 theMarginPad, Rework(SELF.unpaginatedView, zeroPt, screenRes, l, 

000871 SELF. panel. zoomFactor, POINTER( SELF. panel. window. wmgrl d)) 

000872 

000873 FOR row := firstRowStrip TO lastRowStrip DO 

000874 FOR column := firstColStrip to lastColStrip DO 

000875 BEGIN 

000876 IF SELF. printManager. pageRiseDirection = h THEN 

000877 pageNumber := (row~- 1) * pgsPerStrip + column 

000878 ELSE 

000879 pageNumber := (column - 1) * pgsPerStrip + row 

000880 Set LPt(1 Ori gin, 

000881 Lint Mull nt(SELF.pageSize[h], column - 1) - incomingPane. scroll Offset.h, 
000882 Lint Mull nt(SELF. pageSize[v], row 1) - incomingPane. scroll Offset. v) 
000883 SELF.screenPad. LPtToPt(! Origin, origin) 

000884 

000885 theMarginPad. SetForPage( pageNumber, origin); 

000886 

000887 theMarginPad. ClipFurtherTo(incomingPane.innerRect); {clip page down to pane} 
000888 theBodyPad. ClipFurtherTo(incomi ngPane.innerRect); {ditto page body} 
000889 1F focusOnl nterior THEN 

000890 theBodyPad. Focus 

000891 ELSE 

000892 theMarginPad. Focus 

000893 

000894 DoOnAPage 

000895 

000896 END; 

000897 PopFocus; 

000898 {$I1FC fTrace}EP; {$ENDC} 

000899 END; 

000900 

000901 

000902 PROCEDURE {TPagi natedVi ew. }Draw 

000903 PROCEDURE DrawPageOnScreen; 

000904 BEGIN 

000905 SELF. print Manager. DrawPage 

000906 SELF. AdornPageOnScreen; 

000907 END; 
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000908 BEGI N 

000909 {$1FC fTrace}BP( 9); {$ENDC} 

000910 SELF. DoOnPages( FALSE, DrawPageOnScreen) 

000911 {$I1FC fTrace}EP; {$ENDC} 

000912 END; 

000913 

000914 

000915 PROCEDURE {TPagi natedView. }MouseTrack{(mPhase: TPhase; mouseLPt: LPoint)}; 

000916 VAR unPagLPt: LPoint 

000917 BEGIN 

000918 {$IFC fTrace}BP(9); {$ENDC} 

000919 SELF. DepagifyLPoint(mouseLPt, unPagLPt) 

000920 SELF. unpagi natedView. MouseTrack(mphase, unPagLPt); 

000921 {$1FC fTrace}EP; {$ENDC} 

000922 END; 

000923 

000924 

000925 PROCEDURE {TPaginatedView. }}PagifyLPoint{(unPagLPt: LPoint; VAR pagLPt: LPoi nt) }; 

000926 VAR pageBreak: LONGI NT; 

000927 strip: Point; 

000928 vhs: VHSel ect; 

000929 pageNumber: LONGI NT; 

000930 orthoVhs: VHSel ect; 

000931 BEGIN 

000932 {$1 FC fTrace}BP(9); {$ENDC} 

000933 pageNumber := SELF. printManager.PageWth(unPagLPt, strip) 

000934 FOR vhs := v TO h DO 

000935 BEGIN 

000936 orthoVhs := orthogonal[vhs] 

000937 [F (strip.vh[orthoVhs] < 1) OR (strip. vh[orthoVhs] > SELF. printManager. breaks[orthoVhs].Size) THEN 
000938 ABCBreak('PagifyLPt: strip=', strip. vh[orthoVHs]) {only for short-term debugging} 
000939 ELSE 

000940 IF strip. vh[orthoVhs] = 1 THEN 

000941 pagLPt. vh[ vhs] := unPagLPt.vh[vhs] + SELF. printManager. contentLRect.topLleft.vh[ vhs] 
000942 ELSE 

000943 BEGIN 

000944 pageBreak := TpLONGI NT( SELF. print Manager. breaks[orthoVhs].At(strip.vh[orthoVhs] - 1))%; 
000945 pagLPt. vh[ vhs] := unPagLPt.vh[vhs] + SELF. printManager. contentLRect.topLleft.vh[ vhs] 
000946 + Lint Mull nt( SELF. pageSize[vhs], strip. vh[orthoVhs] - 1) - ABS(pageBreak); 
000947 END; 

000948 END; 

000949 {$I1FC fTrace}EP; {$ENDC} 

000950 END; 

000951 

000952 

000953 

000954 {$S SgABCpri } 

000955 PROCEDURE {TPagi natedVi ew. }ReactToPrinterChange 
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000956 VAR panel: TPanel 

000957 BEGIN 

000958 {$IFC fTrace}BP(9); {$ENDC} 

000959 panel := SELF. panel 

000960 panel. Preview(mPrvwOff); {get back to main-view metrics in the panes} 
000961 {Don't refer to SELF after this, since Preview has deallocated me} 

000962 panel. view. React ToPrinterChange 

000963 panel. Preview(mPrvwMargins); {creates fresh paginated view with correct info} 
000964 {$I FC fTrace}EP; {$ENDC} 

000965 END; 

000966 {$S SgABCres} 

000967 

000968 

000969 PROCEDURE {TPagi natedVi ew. }RedoBreaks 

000970 VAR panel: TPanel 

000971 BEGIN 

000972 {$1FC fTrace}BP( 9); {$ENDC} 

000973 panel := SELF. panel 

000974 panel. Preview(mPrvwOff); {get back to main-view metrics in the panes} 
000975 {Don't refer to SELF after this, since Preview has deallocated me} 

000976 panel. view. ReDoBreaks 

000977 panel. Preview(mPrvwMargins); {creates fresh paginated view with correct info} 
000978 {$I1FC fTrace}EP; {$ENDC} 

000979 END; 

000980 

000981 

000982 {$S SgABCi ni } 

000983 END; 

000984 {$8 SgABCres} 

000985 

000986 

000987 METHODS OF TPageView 

000988 

000989 {$S sCldinit} 

000990 FUNCTION {TPageView. }CREATE{(object: TObject; heap: THeap; itsPrintManager: TPrintManager): TPageVi ew}; 
000991 VAR view: TVi ew 

000992 BEGIN 

000993 {$1 FC fTrace}BP(9); {$ENDC} 

000994 view := itsPrint Manager. view 

000995 IF object = NIL THEN 

000996 object := NewObject(heap, THISCLASS) 

000997 SELF := TPageView(TView. CREATE(object, heap, view. panel, itsPrintManager.paperLRect, 
000998 itsPrintManager, zeroLRect, FALSE, view.res, FALSE)); 
000999 {$1 FC fTrace}EP; {$ENDC} 

001000 END; 

001001 {$8 SgABCres} 

001002 

001003 
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{$$ SgABCpri } 
PROCEDURE {TPageView. }Draw 
VAR s: TListScanner; 
heading: THeadi ng; 
pageNumber: LONGI NT; 
outerFrame: LRect; 
headings: TList; 


editing: BOOLEAN; 
BEGIN 
{$1 FC fTrace}BP( 9); {$ENDC} 
PenNor mal 


[F SELF. printManager.frameBody THEN {body should be framed... } 
1F amPrinting THEN 
FrameLRect( SELF. print Manager. contentLRect); 


editing := (SELF. printManager.|ayoutDialogBox <> NIL) AND 
(SELF. print Manager. view. panel. window. dialogBox = SELF. printManager.| ayout Dial ogBox) 


headings := SELF. print Manager. headings; 
IF headings <> NIL THEN 


BEGIN 
pageNumber := theMarginPad. pageNumber 
s := headings. Scanner; {tell each Heading to draw itself} 


WHILE s.Scan( heading) DO 
IF heading. ShouldDraw(pageNumber) THEN 

BEGIN 

IF NOT editing THEN 
BEGIN 
heading. Adj ustForPage( pageNumber, FALSE); {client changes contents/ extent} 
heading. LocateOnPage( FALSE); {...then we adjust to page} 
END; 

heading. Draw; 

END; 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 
{$$ SgABCres} 
{$$ SgABCi ni } 
E ' 


{$$ SgABCres} 


{$$ SgABCi ni } 
METHODS OF TPrint Manager; 
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FUNCTION {TPrint Manager. }CREATE{(object: TObject; heap: THeap): TPrintManager}; 
BEGIN 

{$1FC fTrace}BP( 6); {$ENDC} 

IF object = NIL THEN 

object := NewObject(heap, THISCLASS) 

SELF := TPrintManager( object); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE {TPrintManager. }l nit{(itsMainView: TView; itsDfltMargins: LRect)}; 
VAR paperLRect: LRect; 
I: TArray; 
vhs: VHSel ect; 
pageVi ew: TVi ew 
pageBreak: LONGI NT; 
newList: TList; 
BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
newList := TList.CREATE(NIL, itsMainView. Heap, 0); {the Headings} 


WITH SELF DO 
BEGIN 
view := itsMainView 
headings := newList; 
pageRiseDirection := h; 
frameBody := FALSE; 
layout Di alogBox := NIL; 


canEditPages := FALSE; {subclass may make true} 
END; 
FOR vhs := v TO h DO 
BEGIN 
| := TArray. CREATE(NIL, itsMainView. Heap, 1, SI ZEOF(LONGINT)); 
pageBreak := itsMainView. extentLRect. botRi ght. vh[ orthogonal [vhs]]; 


|. | nsFirst( @pageBreak); 


SELF. breaks[vhs] := |; 
END; 


WITH itsDfltMargins DO 
BEGIN {$H- } 
left := ABS(left); 
top := ABS(top); 
right := - ABS(right); 
bottom:= - ABS(bottom); 
END; {$H+} 
SELF. pageMargins := itsDfltMargins 
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001100 

001101 pageView := SELF. NewPageVi ew( NIL) 

001102 SELF. pageView := pageView 

001103 

001104 SELF. Set Dfl tHeadi ngs; {NB: TView. CREATE will, after calling me, call ReactToPrinterChange 
001105 until that's done, things are not necessarily in synch} 
001106 {$1FC fTrace}EP; {$ENDC} 

001107 END; 

001108 

001109 

001110 {$8 SgABCi ni } 

001111 PROCEDURE {TPrint Manager. }Free 

001112 VAR vhs: VHSel ect 

001113 BEGIN 

001114 {$1FC fTrace}BP( 2); {$ENDC} 

001115 FOR vhs := v TO h DO 

001116 1F SELF. breaks[vhs] <> NIL THEN 

001117 SELF. breaks[vhs]. Free 

001118 Free( SELF. pageVi ew); 

001119 SUPERSELF. Free 

001120 {$I1FC fTrace}EP; {$ENDC} 

001121 END; 

001122 {$S SgABCres} 

001123 

001124 

001125 {$1 FC fDebugMet hods} 

001126 {$S SgABCdbg} 

001127 PROCEDURE {TPrint Manager. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
001128 BEGIN 

001129 Field('view: TView'); 

001130 Field('pageView: TPageView' ); 

001131 Field('breaks: ARRAY[0..1] OF TArray'); 

001132 Field('pageMargins: LRect'); 

001133 Field('headings: TList'); 

001134 Field('canEditPages: BOOLEAN' ) 

001135 Field('layoutDialogBox: TDi al ogBox'); 

001136 Field('frameBody: BOOLEAN’ ) 

001137 Field('paperLRect: LRect'); 

001138 Field('printableLRect: LRect'); {safeLRect out} 

001139 Field('contentLRect: LRect'); 

001140 Field(CONCAT('printerMetrics: RECORD paperRect: Rect; printRect: Rect; ', 
001141 ‘res: Point; reserve: ARRAY[0..7] OF Byte END')); 
001142 Field('pageRiseDirection: BOOLEAN' ) 

001143 Field(''); 

001144 END; 

001145 {$S SgABCres} 

001146 {$ENDC} 

001147 
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{$S SgABCpri } 
PROCEDURE {TPrint Manager. }AddStri pOfPages{(vhs: VHSelect) }; 
VAR newExtentLRect: LRect; 


BEGIN 


adj ust ment: LONGI NT; 


{$I FC fTrace}BP(7); {$ENDC} 
WITH SELF.contentLRect DO {cd save a mote by flipping vhs just before this} 


{$H- } 


adjustment := botRight.vh[orthogonal[vhs]] - 
WITH SELF. view. extentLRect DO 
IF vhs = v THEN 


topLeft.vh[ orthogonal [vhs]]; 


SetLRect(newExtentLRect, left, top, right + adjustment, bottom) 


ELSE 


SetLRect(newExtentLRect, left, top, right, bottom + adjustment); {$H+} 


SELF. view. Resi ze(newExtentLRect); 
SELF. RedoBreaks:; 


{$I1FC fTrace}EP; {$ENDC} 


END; 


{$S SgABCres} 


{$S SgABCpri } 
PROCEDURE {TPrint Manager. }ChangeMargins{(margins: LRect)}; 


BEGIN 


{$1 FC fTrace}BP(7); {$ENDC} 
WITH margins DO 


BEGIN {$H-} 
left := ABS(left); 
top := ABS(top); 


right := - ABS(right); 
bottom := - ABS(bottom); 
END; {$H+} 


SELF. pageMargins := margins 

SELF. view. panel. current View. ReactToPrinterChange 
SELF. view. panel. I nvalidate 

{$I1FC fTrace}EP; {$ENDC} 


END; 


{$S SgABCres} 


{$$ sCldl nit} 
PROCEDURE {TPrint Manager. }Cl earPageBreaks{( automatic: BOOLEAN) }; 


BEGIN 


VAR s: 


TListScanner; 
break: LONGI NT; 

vhs: VHSel ect; 
endOf View: LONGI NT 
breakl ndex: INTEGER; 
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001196 {$I1FC fTrace}BP(9); {$ENDC} 

001197 { Clears all page breaks of the specified kind EXCEPT for the one marking the end of the view } 
001198 FOR vhs := v TO h DO 

001199 BEGIN 

001200 endOf View := SELF. view. extentLRect. bot Ri ght. vh[ orthogonal [vhs] ]; 
001201 breakI ndex := 1: 

001202 WHILE breakIndex < SELF. breaks[vhs].size DO 

001203 BEGIN 

001204 break := TpLONGI NT( SELF. breaks[ vhs]. At( breakl ndex)) *; 
001205 IF (break >= 0) = automatic THEN 

001206 1F ABS(break) < endOf View THEN 

001207 BEGIN 

001208 SELF. breaks[vhs]. Del At ( breakl ndex) 

001209 breakI ndex := breakl ndex - 1; 

001210 END; 

001211 breakIl ndex := breaklndex + 1; 

001212 END; 

001213 END; 

001214 {$I1FC fTrace}EP; {$ENDC} 

001215 END; 

001216 {$S SgABCres} 

001217 

001218 

001219 PROCEDURE {TPrint Manager. }DrawBreaks{( manual Onl y: BOOLEAN) }; 

001220 VAR wLPtl: LPoint 

001221 wL Pt 2: LPoint 

001222 vhs: VHSel ect; 

001223 dir: VHSel ect; 

001224 vi ewEnd: LONGI NT; 

001225 visEnd: LONGI NT; 

001226 wi dthAdj ust: INTEGER 

001227 showing: BOOLEAN; 

001228 limit: LONGI NT; 

001229 pageBreak: LONGI NT; 

001230 breakli ndex: INTEGER 

001231 finished: BOOLEAN 

001232 BEGIN 

001233 {$1 FC fTrace}BP(9); {$ENDC} 

001234 thePad. Dist ToLDist(autoBreakPen, pnSize, wLPt1l); 

001235 thePad, Dist ToLDist( manual BreakPen. pnSize, wLPt2) 

001236 1F NOT amPrinting THEN 

001237 FOR vhs := v TO h DO 

001238 BEGIN 

001239 {Inhibit display of breaks to the top/left of the pane} 
001240 dir := orthogonal [vhs] 

001241 viewEnd := SELF. view, extentLRect. botRi ght. vh[ dir] 
001242 visEnd := thePad. visLRect. botRight.vh[ dir]; 

001243 widthAdjust := Max(wlLPtl.vh[dir], wlPt2.vh[dir]) + 1; {add 1 in case of roundoff 
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001244 probl ems } 
001245 

001246 showing := FALSE; 

001247 limit := thePad. visLRect.topLeft.vh[dir]; 

001248 

001249 breakI ndex := 1; 

001250 finished := FALSE: 

001251 WHILE (breakIl ndex <= SELF. breaks[vhs].size) AND NOT finished DO 
001252 BEGIN 

001253 pageBreak := TpLONGI NT( SELF. breaks[ vhs]. At( breakl ndex) ) *; 
001254 1F ABS(pageBreak) >= limit THEN 

001255 BEGIN 

001256 1F NOT showing THEN {Start displaying breaks; reset limit to where we'll stop} 
001257 limit := Min(viewEnd, visEnd + widthAdj ust); 
001258 showing := ABS(pageBreak) < limit 

001259 [F NOT showing THEN {Stop displaying breaks} 
001260 finished := TRUE; 

001261 END; 

001262 1F showing THEN 

001263 1F NOT ( (pageBreak >= 0) AND manual Only) THEN 
001264 SELF. DrawOneBreak( pageBreak, vhs); 

001265 breakIl ndex := breakl ndex + 1; 

001266 END; 

001267 END; 

001268 {$I1FC fTrace}EP; {$ENDC} 

001269 END; 

001270 

001271 

001272 PROCEDURE {TPrint Manager. }DrawOneBreak{(pageBreak: LONGINT; vhs: vhSelect)}; 
001273 VAR | Pt: LPoint; 

001274 | Pt 2: LPoint; 

001275 pt: Point; 

001276 wPt: Point; {width of line} 

001277 BEGIN 

001278 {$IFC fTrace}BP(6); {$ENDC} 

001279 

001280 1F pageBreak >= 0 THEN 

001281 thePad. SetPen( aut oBreakPen) 

001282 ELSE 

001283 thePad. Set Pen( manual BreakPen) 

001284 

001285 | Pt1 := zeroLPt 

001286 1Pt2 := SELF. view. extentLRect. bot Ri ght 

001287 1Ptl.vh[orthogonal[vhs]] := ABS(pageBreak); 

001288 1Pt2,vh[orthogonal[vhs]] := ABS(pageBreak); 

001289 

001290 wPt := thePort*. pnSize 

001291 wPt. vh[ vhs] := 0: 
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001292 

001293 thePad, LPtToPt(IPt1, pt); 

001294 MoveTo(pt.h - wPt.h, pt.v - wPt.v); {wPt adjustment to hang line off top/left, not bot/right} 
001295 

001296 thePad, LPtToPt(IPt2, pt); 

001297 LineTo(pt.h - wPt.h, pt.v - wPt.v); {wPt adjustment to hang line off top/left, not bot/right} 
001298 {$I1FC fTrace}EP; {$ENDC} 

001299 END; 

001300 

001301 

001302 {$S SgABCpri } 

001303 PROCEDURE {TPrint Manager. }DrawPage 

001304 VAR heading: THeadi ng; 

001305 content Rect: Rect; 

001306 BEGI N 

001307 {$I1FC fTrace}BP(7); {$ENDC} 

001308 IF (amPrinting) AND (SELF.frameBody) THEN {client wants frame drawn on printed page} 
001309 BEGIN 

001310 theMarginPad, LRectToRect(SELF.contentLRect, contentRect); 

001311 PenNor mal 

001312 PenSi ze(3, 2); 

001313 PenMode(patOr); 

001314 InsetRect(contentRect, -l, -1) 

001315 FrameRect (content Rect); 

001316 END; 

001317 

001318 SELF. pageView. Draw; {will draw headings and possibly frame body} 

001319 

001320 theBodyPad. Focus 

001321 SELF. view. Draw 

001322 {$I1FC fTrace}EP; {$ENDC} 

001323 END; 

001324 {$S SgABCres} 

001325 

001326 

001327 {$S SgABCpri } 

001328 PROCEDURE {TPrint Manager. }EnterPageEditting 

001329 BEGIN 

001330 {$I1FC fTrace}BP(7); {$ENDC} 

001331 {$I1FC fTrace}EP; {$ENDC} 

001332 END; 

001333 {$S SgABCres} 

001334 

001335 

001336 {$S SgABCpri } 

001337 PROCEDURE {TPrint Manager. }Get PageLi mits{( pageNumber: LONGINT; VAR viewLRect: LRect)}; 
001338 { NB: 

001339 The default is that page numbers go up fromleft-to-right, as illustrated by: 


Apple Lisa ToolKit 3.0 Source Code Listing -- 194 of 1012 


001340 
001341 
001342 
001343 
001344 
001345 
001346 
001347 
001348 
001349 
001350 
001351 
001352 
001353 
001354 
001355 
001356 
001357 
001358 
001359 
001360 
001361 
001362 
001363 
001364 
001365 
001366 
001367 
001368 
001369 
001370 
001371 
001372 
001373 
001374 
001375 
001376 
001377 
001378 
001379 
001380 
001381 
001382 
001383 
001384 
001385 
001386 
001387 


Apple Lisa Computer Technical Information 


This is what is obtained by leaving TPrintManager. pageRiseDirection 
at its default value of 'h'; to get the transpose, set pageRiseDirection ‘Vv 


} 
VAR 
total Strips: INTEGER; {if pageRiseDirection is h, this is the total number of column 
strips} 
pageRiseDirection: VHSelect 
orthoDirection: VHSel ect; 
strips: Point; 
vhs: VHSel ect; 
breakArray: TArray {OF LONGI NT}; 
strip: INTEGER; 
nextLocation: LONGI NT; 
pageBreak: LONGI NT; 
BEGIN 


{$1FC fTrace}BP( 9); {$ENDC} 

pageRiseDirection := SELF. pageRiseDi rection; 
orthoDirection := orthogonal [ pageRiseDi rection] 
total Strips := SELF. breaks[orthoDirection].size 


strips. vh[orthoDirection] := ((pageNumber - 1) DIV totalStrips) + 1; 
strips. vh[pageRiseDirection] := pageNumber - ((strips.vh[orthoDirection] - 1) * totalStrips); 


FOR vhs := v TO h DO 
BEGIN 
breakArray := SELF. breaks[ orthogonal [vhs] ]; 
strip := strips.vh[vhs] 


IF strip = 1 THEN 
nextLocation := 0 
ELSE 
BEGIN 
pageBreak := TpLONGINT( breakArray. At(strip - 1))*; 
nextLocation := ABS( pageBreak); 
END; 


viewLRect.topLeft.vh[vhs] := nextLocation; 
pageBreak := TpLONGINT( breakArray. At(strip))*; 
viewLRect. bot Right. vh[ vhs] := ABS(pageBreak); 
END; 
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{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


FUNCTION {TPrint Manager. }NewPageView{(object: TObject): NewPageVi ew}; 
BEGIN 

{$1FC fTrace}BP( 6); {$ENDC} 

NewPageView := TPageView. CREATE(object, SELF.Heap, SELF); 

{$IFC fTrace}EP; {$ENDC} 
END; 


FUNCTION {TPrint Manager. }NewPaginatedView{(object: TObject): TPaginatedVi ew}; 
{Building Block or Client reimplements this to install own flavor of paginated vi ew} 
BEGIN 

{$IFC fTrace}BP( 6); {$ENDC} 

NewPaginatedView := TPaginatedView. CREATE(object, SELF.Heap, SELF. vi ew) 

{$IFC fTrace}EP; {$ENDC} 
END; 


FUNCTION {TPrintManager. }}PageWth{(VAR | PtIlnView: LPoint; VAR strip: Point): LONGINT}; 
VAR pageBreak: LONGI NT; 
curStrip: INTEGER 
vhs: VHSel ect; 
finished: BOOLEAN 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
LRectHaveLPt( SELF. view. extentLRect, | PtI nVi ew) 
FOR vhs := v TO h DO 


BEGIN 

finished := FALSE: 

curStrip := 1; 

WHILE (curStrip <= SELF. breaks[orthogonal[vhs]].size) AND NOT finished DO 
BEGIN 


pageBreak := TpLONGI NT( SELF. breaks[ orthogonal [vhs]].At(curStrip))%; 
IF I PtinView.vh[vhs] <= ABS(pageBreak) THEN 
BEGIN 
strip. vh[orthogonal[vhs]] := curStrip; 
finished := TRUE; 
END 
ELSE 
curStrip := curStrip + 1; 
END; 
END; 
PageWth := (strip. vh[SELF. pageRiseDirection] - 1) * 
SELF. breaks[ orthogonal [SELF. pageRiseDirection]].size 
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* strip. vh[ orthogonal [SELF. pageRiseDirecti on] ] 
{$IFC fTrace}EP; {$ENDC} 
END; 


{Note: The Pepsi and the Spring versions of the following procedure are completely different} 


{$1FC libraryVersion <= 20} { PEPSI } 
{$S SgABCpri } 
PROCEDURE {TPrintManager. }Print{(printPref: TPrReserve) }; 
LABEL 1,2,3,4,5,6; {as demanded by Print Manager} 


VAR scaleOne: TScaler 
pageNumber: LONGI NT; 
rBand: Rect; 
pgsTotal: LONGI NT; 
printerMetrics: TPrinterMetrics; 
error: INTEGER; 
dispatchCode: INTEGER; {dispatch code from LisaPrint} 
f Spool: BOOLEAN; 
prPrfAlias: TPrPrfAlias; 
BEGIN 


{$1FC fTrace}BP( 9); {$ENDC} 
prPrfAlias. reserve := printPref; 
printerMetrics := SELF. printerMetrics; 
Set Pt(ScaleOne. numerator, 1, 1); 
Set Pt(ScaleOne. denominator, 1, 1); 
pgsTotal := SELF.view. MaxPageToPrint; {by default, # of rowBreaks * # of col Breaks} 
fSpool := TRUE; 


PrDocStart(dispatchCode, prPrfAlias.prins, printLDSN); {open the printer} 
CASE PrCheckErr(dispatchCode) OF 


PrGoDocStart: BEGIN 
fSpool := FALSE; 
GOTO 1; 
END: 
PrGoDocEnd: GOTO 5; 
PrGoExit: GOTO 6 


END; { case } 
t heMar gi nPad. Rework 
(SELF.view, zeroPt, printerMetrics.res, 1, 
scaleOne, printerPseudoPort); {set up margin/body pads... } 
pageNumber := 0 


REPEAT 
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001484 pageNumber := pageNumber + 1; 

001485 

001486 2: PrStartPage(dispatchCode); 

001487 CASE PrCheckErr(dispatchCode) OF 

001488 

001489 prGoDocStart: BEGIN 

001490 fSpool := FALSE; 

001491 GOTO 1; 

001492 END; 

001493 

001494 prGoStartPage: GOTO 2; 

001495 

001496 prGoEndPage: BEGIN 

001497 SELF. Ski pPage( pageNumber); {read on to start of next page, without 
001498 printing this one} 
001499 GOTO 4; 

001500 END; 

001501 

001502 prGoDocEnd: GOTO 5; 

001503 prGoExit: GOTO 6; 

001504 

001505 prGoCont: {actually print the page} 
001506 BEGIN 

001507 theMarginPad. SetForPage( pageNumber, zeroPt); 
001508 WHILE PrNextBand(rBand) DO 

001509 BEGIN 

001510 theMarginPad. Cli pFurt her To(rBand) 

001511 theMarginPad. Focus 

001512 SELF. DrawPage; 

001513 3: Pr DumpBand(dispatchCode) 

001514 CASE PrCheckErr(dispatchCode) OF 

001515 PrGoDocStart: 

001516 BEGIN 

001517 fSpool := FALSE; 
001518 GOTO 1; 

001519 END; 

001520 

001521 PrGoStartPage: ABCBreak('PrGoStartPage received; page #=', pageNumber); 
001522 PrGoDumpBand : GOTO 3; 

001523 PrGoEndPage : GOTO 4; 

001524 PrGoDocEnd : GOTO 5; 

001525 PrGoExit : GOTO 6; 

001526 END; { CASE } 

001527 END; {WHILE PrNext Band} 

001528 END; {prGoCont dispatch code from prStart Page} 
001529 END; {case on Err from Start Page} 

001530 

001531 4: PrEndPage(dispatchCode) 
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CASE PrCheckErr(dispatchCode) OF 
PrGoDocStart: BEGIN 
f Spool := FALSE; 
GOTO 1; 
END; 


PrGoExit: GOTO 2; 
END; { case } 


UNTIL pageNumber = pgsTotal 


PrDocEnd(dispatchCode); 
CASE PrCheckErr(dispatchCode) OF 


PrGoDocStart: BEGIN 
fSpool := FALSE; 
GOTO 1; 
END; 


PrGoStartPage: ABCBreak('PrGoStartPage received; page #=', pageNumber) 


PrGoDocEnd : GOTO 5; 
PrGoExit : GOTO 6 
END; { case } 


{$1FC fTrace}EP; {$ENDC} 


{spring-release version of TPrintManager. Print follows} 
{$S SgABCpri } 
PROCEDURE {TPrint Manager. }Print{(printPref: TPrReserve) }; 


VAR unzoomed: TScaler: 
pageNumber: LONGI NT; 
pgsTotal: LONGI NT; 
prPort: TPrPort; 
prPrfAlias: TPrPrfAlias; 
resPageEnd: BOOLEAN 


BEGIN 


{$IFC fTrace}BP( 9); {$ENDC} 
prPrfAlias.reserve := printPref; 
SetPt(unzoomed. numerator, 1, 1); 
SetPt(unzoomed. denominator, 1, 1) 


{ END of Pepsi-release version of TPrintmanager. Print } 


(RRR RRR RRR RRR RRR RRA AAA R RRR RRR RR RR RRR RRR RRR RRR RRR RRR RRR RAK AAA ARR RRR RR RRR RRR RRR RRA KAKA KR RRR RK KKK KKK) 


pgsTotal := SELF.view. MaxPageToPrint; {by default, # of rowBreaks * # of col Breaks} 
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{$1FC LibraryVersion < 30} 
prPrfAlias. prPrf.prLdsn := printLDSN 
IF PrDocStart(prPrfAlias.prPrf, prPort {, printLDSN} ) THEN {open the printer} {++} 
{NB ldsn param not currently in spring interface, but Eric Z says it's going back in} 
{$ELSEC} 
[F PrDocStart(prPrfAlias.prPrf, prPort , printLDSN, TRUE) THEN {open the printer} {++} 
{$ENDC} 
BEGIN 
theMarginPad. Rework 
(SELF.view, zeroPt, SELF. printerMetrics.res, l, 
unzoomed, printerPseudoPort); {set up margin/body pads... } 
RectRgn(altVisRgn, hugeRect); 
useAltVisRgn := TRUE; 


pageNumber := 0 


REPEAT 
pageNumber := pageNumber + 1; 


1F NOT PrPageStart(prPrfAlias.prPrf, prPort) THEN {+SW+} 
SELF. SkipPage(pageNumber) {read on to start of next page, without printing this one} 

ELSE 
BEGIN 
theMarginPad. SetForPage( pageNumber, zeroPt); 
theMarginPad. Focus; 
SELF. DrawPage; 
END; 

resPageEnd := PrPageEnd(prPrfAlias.prPrf, prPort); 

UNTIL 
resPageEnd OR (pageNumber >= pgsTotal); 


PrDocEnd(prPrfAlias. prPrf, prPort); 
{??? Do we need to stuff the prRec back into the doc?? Must ask Bayles} 


useAltVisRgn := FALSE; 
END; 


{$I1FC fTrace}EP; {$ENDC} 
END; 
{$$ SgABCres} 
{$ENDC} {End of Spring-Release version of TPrintManager. Print} 


{$$ sCldi nit} 
PROCEDURE {TPrint Manager. }ReactToPrinterChange; {several changes} 
VAR newExtent: LRect; 
mi nVi ewLRect: LRect; 
S! TListScanner; 
pageBreak: LONGI NT; 
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vhs: VHSel ect; 
curLPt: LPoint 

pagel ncrement: LONGI NT; 
metrics: TPrinter Metrics 


PROCEDURE ScaleToViewedSpace(printRect: Rect; VAR viewedLRect: LRect); 
BEGIN 
SetLRect(viewedLRect, 

LI nt Ovri nt( ORD4(printRect. left) * SELF.view.res.h, metrics.res.h) 
LI nt Ovri nt( ORD4(printRect. top) * SELF.view.res.v, metrics.res.v) 
Li ntOvrint(ORD4(printRect. right) * SELF.view.res.h, metrics.res.h) 
Li ntOvrint(ORD4(printRect. bottom) * SELF.view.res.v, metrics.res.v)); 

END; 


BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
{ SELF.InvalidatePageBreaks, or some such ???} 
SELF. view. panel. window. GetPrinterMetrics; {except maybe for viewin first Panel created, this wil 
be an unnecessary (but inexpensive) step} 
metrics := SELF. view. panel. window. printerMetrics; 
SELF. printerMetrics := metrics 


WITH SELF, printerMetrics DO 
BEGIN 
{$H- } ScaleToViewedSpace(paperRect, paperLRect) 
ScaleToViewedSpace(printRect, printableLRect); 
END; 
LRect PlusLRect(SELF.paperLRect, SELF. pageMargins, SELF.contentLRect); {$H+} 


SELF. pageVi ew. Resi ze( SELF. paperLRect); 
SELF. view. SetMinViewSize(newExtent); {++} 
SELF. view. Resize(newExtent); {set view back to its min size} 
SELF. RedoBreaks; {may resize the view upwards again by a bit} 
{SELF.I nvalidatePageBreaks again -- to force update where new breaks are to be shown} 
{$1 FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sCldl nit} 
PROCEDURE {TPrint Manager. }RedoBreaks; 

VAR vhs: VHSel ect; 
maxViewPixelsPerPage: INTEGER 
curLocation: LONGI NT; 
onePi xel TooMuch: LONGI NT; 
endOf Vi ew: LONGI NT 
S! TListScanner; 
next PageBreak: LONGI NT; 
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breakl ndex: INTEGER 
penultimatePageBreak: LONGI NT; 
newVi ewExtent: LRect; 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
newVi ewExtent := SELF. view. extentLRect 
SELF. ClearPageBreaks(TRUE); {clear out old automatic breaks} 
FOR vhs := v TO h DO 
BEGIN 
WITH SELF.contentLRect DO 
1F vhs = v THEN 
maxViewPixelsPerPage := right - left 
ELSE 
maxViewPixelsPerPage := bottom ~ top; 


endOfView := SELF. view. extentLRect. bot Right. vh[orthogonal[vhs]]; 


breakI ndex := 1: 

curLocation := 0: 

WHILE curLocation < endOf View DO 
BEGIN 


next PageBreak := TpLONGINT( SELF. breaks[vhs]. At(breaklI ndex))*; 

onePixel TooMuch := Min(curLocation + MaxViewPixelsPerPage, endOf Vi ew) 

1F ABS(nextPageBreak) <= onePixel TooMuch THEN 
curLocation := ABS(nextPageBreak) 

ELSE {no manual page break; impose an automatic one -- propose onePi xel TooMuch} 
BEGIN 
curLocation := SELF. view. ForceBreakAt(vhs, curLocation, onePixel TooMuch) 
SELF. breaks[vhs].I nsAt(breakIl ndex, @curLocation); 
END; 

breakI ndex := breakIl ndex + 1; 

END; 


[F SELF.view.fitPagesPerfectl y THEN {make minor adjustment upward} 
BEGIN 
IF (SELF. breaks[vhs].size > 1) THEN 


penultimatePageBreak := TpLONGINT(SELF. breaks[vhs]. At( SELF. breaks[vhs].size - 


ELSE 
penultimatePageBreak := 0; 
newVi ewExtent. botRi ght. vh[ orthogonal [vhs]] := ABS(penultimatePageBreak) + 
max Vi ewPi xel sPer Page 
END; 


END; {for vhs := v to h} 
SELF. view. Resize(newVi ewExtent); 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 
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{$S SgABCpri } 


PROCEDURE {TPrint Manager. }SetBreak{(vhs: VHSelect; where: LONGINT; isAutomatic: 


VAR s: TListScanner; 
break: LONGI NT; {comment gone} 
prevBreakLoc: LONGI NT; 
breakl ndex: INTEGER; 
finished: BOOLEAN 

BEGIN 

{$1FC fTrace}BP( 9); {$ENDC} 

prevBreakLoc := 0 

breakI ndex := 1; 


finished := FALSE: 
WHILE (breakIl ndex <= SELF. breaks[vhs].size) AND NOT finished DO 
BEGIN 
break := TpLONGINT( SELF. breaks[vhs].At(breakl ndex)) *; 
1F ABS(break) > where THEN 
{found where to insert! } 
BEGIN 
where := SELF. view. ForceBreakAt(vhs, prevBreakLoc, where); 
break := where 
1F NOT isAutomatic THEN 
break :=- break 
SELF. breaks[vhs].InsAt(breakl ndex, @break); 
finished := TRUE; 
END 
ELSE 
1F ABS(break) = where THEN 
{replace an existing page break} 
BEGIN 
break := where 
1F NOT isAutomatic THEN 
break :=- break 
SELF. breaks[vhs]. PutAt(breakIl ndex, @break) 
finished := TRUE; 
END 
ELSE 
prevBreakLoc := ABS( break) 


breakIl ndex := breakIl ndex + 1; 
END; 
{$I FC fTrace}EP; {$ENDC} 


END; 
{$S SgABCres} 


{$$ SgABCcl d} 


BOOLEAN) }; 
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PROCEDURE {TPrintManager. }SetDfltHeadings; {client redefines} 


C fTrace}BP( 7); {$ENDC} 
C fTrace}EP; {$ENDC} 


aa 
tA 
mn. 


END; 
{$S SgABCres} 


{$S SgABCpri } 
PROCEDURE {TPrintManager. }Ski pPage{( pageNumber: LONGI NT) }; 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCi ni } 

END; 

{$$ SgABCres} 
METHODS OF THeadi ng; 


{$$ SgABCi ni} 


{client may want to redefine} 


FUNCTION {THeading. }CREATE{(object: TObject; heap: THeap; itsPrintManager: TPrintManager; 


itsExtentLRect: LRect; itsPageAlignment: TPageAlignment; itsOffsetFromAlignment: LPoint): 


BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 


SELF := THeading(Tl mage. CREATE( object, heap, itsExtentLRect, itsPrint Manager. pageVi ew) ) 


WITH SELF DO 
BEGIN 
printManager := itsPrint Manager 
pageAlignment := itsPageAlignment; 
offsetFromAlignment := itsOffsetFromAl i gnment 


oddOnly := FALSE; 
evenOnly := FALSE; 
mi nPage : : 
max Page 


MAXLI NT; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


Apple Lisa ToolKit 3.0 Source Code Listing -- 204 of 1012 


THeadi ng}; 


001820 
001821 
001822 
001823 
001824 
001825 
001826 
001827 
001828 
001829 
001830 
001831 
001832 
001833 
001834 
001835 
001836 
001837 
001838 
001839 
001840 
001841 
001842 
001843 
001844 
001845 
001846 
001847 
001848 
001849 
001850 
001851 
001852 
001853 
001854 
001855 
001856 
001857 
001858 
001859 
001860 
001861 
001862 
001863 
001864 
001865 
001866 
001867 


Apple Lisa Computer Technical Information 


{$1 FC fDebugMet hods} 
{$S SgABCdbg} 
PROCEDURE {THeading. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 
Tl mage. Fields( Field); 
Field('printManager: TPrintManager' ); 
Field('pageAlignment: Byte’); {enumerated type} 
Field('offsetFromAlignment: LPoint'); 
Field('oddOnly: BOOLEAN'); 
Field('evenOnly: BOOLEAN' ); 
Field('minPage: LONGI NT'); 
Field('maxPage: LONGI NT' ) 


Field(''); 
END; 
{$S SgABCcl d} 
{$ENDC} 


PROCEDURE {THeading. }Adj ustForPage{(pageNumber: LONGINT; editing: BOOLEAN) }; 
{will be overridden in Subclass if meaningful } 
BEGIN 
{$1FC fTrace}BP(9); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 


PROCEDURE {THeading. }ChangePageAl i gnment {(newPageAlignment: TPageAl i gnment) }; 


VAR newOffset: LPoint 
FUNCTION Mid(anLRect: LRect; vhs: VHSelect): LONGI NT; 
BEGIN 
Mid := (anLRect.topLeft.vh[vhs] + anLRect. botRight.vh[vhs]) DIV 2; 
END; 
BEGIN 


{$1FC fTrace}BP( 9); {$ENDC} 
IF SELF.pageAlignment <> newPageAlignment THEN 
BEGIN 
CASE newPageAlignment OF 
aTopLeft, aBottomleft: 


newOffset.h := SELF.extentLRect. left - SELF.view.extentLRect. left; 


aTopCenter, aBottomCenter: 


newOffset.h := Mid(SELF.extentLRect, h) - Mid(SELF. view. extentLRect, 


aTopRight, aBottomRi ght: 


newOffset.h := SELF.extentLRect.right - SELF.view.extentLRect. right 


END; 
CASE newPageAlignment OF 
aTopLeft, aTopCenter, aTopRi ght: 


newOffset.v := SELF.extentLRect.top - SELF. view. extentLRect. top; 
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aBottomLeft, aBottomCenter, aBottomRi ght: 
newOffset.v := SELF.extentLRect. bottom - SELF. view. extentLRect. bottom 
END; 
SELF. offsetFromAlignment := newOffset; 
SELF. pageAlignment := newPageAl i gnment; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE {THeading.}Draw; {will be overridden in Subclass if meaningful } 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
1F SELF.shouldFrame THEN 
FrameLRect(SELF.extentLRect); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE {THeading. }LocateOnPage{(editing: BOOLEAN) }; 
{called after client has adjusted the extentLRect and (possibly) the offsetFromAl i gnment } 
VAR currentH, currentV, targetH, targetV: LONGI NT; 
offset: LPoint; 
pmgr: TPrint Manager; (* CIRCUMVENT COMPILER BUG *) 
{NB: Someday someone could use vhs and other tricks to tighten this up} 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
WITH SELF DO 
BEGIN (* CIRCUMVENT COMPILER BUG *) 
pmgr := SELF. printManager; (* CIRCUMVENT COMPILER BUG *) 
WTH pmgr, paperLRect DO 
BEGIN 
CASE {SELF. }pageAlignment OF 
aTopLeft, 
aBottomLeft: BEGIN 
currentH := {SELF. }extentLRect.left; 
targetH := {paperLRect. }left; 
END; 
aTopCenter, 
aBottomCenter: BEGIN 
currentH := (extentLRect. right + extentLRect.left) DIV 2; 
targetH := {paperLRect. }(right + left) DIV 2; 


END; 
aTopRi ght 
aBottomRi ght: BEGIN 
currentH := extentLRect.ri ght; 
targetH := right; 
END; 
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END; 
CASE {SELF. }pageAlignment OF 
aTopLeft, 
aTopCenter, 
aTopRi ght: BEGIN 
currentV := extentLRect.top; 
targetV := top; 
END; 
aBottomLeft, 
aBottomCenter, 
aBottomRi ght: BEGIN 
currentV := extentLRect. bottom 
targetV := bottom 
END; 
END; 
END; 
END; (* CIRCUMVENT COMPILER BUG *) 


WITH SELF. offsetFromAlignment DO 
{$H-}SetLPt(offset, targetH - currentH + h, targetV - currentV + v); {$H+} 
SELF. Offset By(offset); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


FUNCTION {THeading. }ShouldDraw{( pageNumber: LONGINT): BOOLEAN}; 
VAR judgment: BOOLEAN 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
WITH SELF DO 
1F (oddOnly AND NOT ODD( pageNumber)) OR 
(evenOnl y AND ODD( pageNumber) ) OR 
(pageNumber < mi nPage) OR 
(pageNumber > maxPage) THEN 
judgment := FALSE 
ELSE 
judgment := TRUE; 
ShouldDraw := j udgment; 
{$1FC fTrace}EP; {$ENDC} 
END; 


FUNCTION {THeading. }ShouldFrame{: BOOLEAN}; 
BEGIN 
{$IFC fTrace}BP(9); {$ENDC} 
ShouldFrame := NOT amPrinting; {default} 
{$SIFC fTrace}EP; {$ENDC} 
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END; 


SgABCi ni } 


SgABCres} 


METHODS OF TSel ection; 


{$S sStartup} 
FUNCTION {TSelection. }CREATE{(object: TObject; heap: THeap; 
itsAnchorLPt: LPoint): TSelection}; 
BEGIN 
{$1FC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TSelection(obj ect); 
WITH SELF DO 
BEGIN 
currLPt := itsAnchorLPt 
anchorLPt := itsAnchorLPt; 
boundLRect := hugeLRect; 
kind := itsKind: 
view := itsView 
panel := view. panel 
IF panel <> NIL THEN 
window := panel. window 
coSelection := NIL; 
canCrossPanels := FALSE; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sRes} 
FUNCTION {TSelection. }Clone{(heap: Theap): TObject}; 
VAR selection: TSelection; 
coSelection: Tselection; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
selection := TSelection(SUPERSELF. Cl one( heap) ) 
IF SELF.coSelection <> NIL THEN 
BEGIN 
coSelection := TSelection(SELF. coSel ection. Clone(heap)); 
selection.coSelection := coSelection; 
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END; 
Clone := selection; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSelection. }Free 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
Free(SELF.coSel ection); 
TObj ect. Free; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 


FUNCTION {TSelection. }FreedAndRepl acedBy{(selection: TSelection): TSelecti on}; 


BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
SELF. Become(sel ection); 
FreedAndRepl acedBy := SELF; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$S SgABCdbg} 
PROCEDURE {TSelection. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 
Field(' window: TWindow'); 
Field(' panel: TPanel') 
Field('view: TView'); 
Field('kind: INTEGER' ) 
Field('anchorLPt: LPoint'); 
Field('currLPt: LPoint'); 
Field('boundLRect: LRect'); {+++LSR+++} 
Field('coSelection: TSelection'); 
Field('canCrossPanels: BOOLEAN'); 


Field(''); 
END; 
{$S SgABCres} 
{$ENDC} 
{$$ sRes} 


FUNCTION {TSelection. }}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkit: 


BEGIN 
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002060 {$1 FC fTrace}BP(6); {$ENDC} 

002061 IF SELF.coSelection <> NIL THEN 

002062 CanDoCommand := SELF. coSelection. CanDoCommand(cmdNumber, checkit) 
002063 ELSE 

002064 CanDoCommand := SELF. window. CanDoCommand(cmdNumber, checklt) 
002065 {$I1FC fTrace}EP; {$ENDC} 

002066 END; 

002067 

002068 

002069 {$$ sAlert} 

002070 PROCEDURE {TSel ection. }CantDoCmd{(cmdNumber: TCmdNumber) }; 
002071 VAR cmdStr: $255: 

002072 BEGIN 

002073 {$I1FC fTrace}BP(7); {$ENDC} 

002074 IF menuBar. GetCmdName(cmdNumber, @cmdStr) THEN 
002075 BEGIN 

002076 process. ArgAlert(1, cmdStr); 

002077 process. Stop( phUnkCmd) ; 

002078 END 

002079 ELSE 

002080 SELF. Cant Dolt; 

002081 {$I1FC fTrace}EP; {$ENDC} 

002082 END; 

002083 

002084 

002085 {$$ sAlert} 

002086 PROCEDURE {TSel ection. }CantDolt; 

002087 VAR ph: INTEGER 

002088 BEGIN 

002089 {$I1FC fTrace}BP(7); {$ENDC} 

002090 [F SELF. kind = nothingKind THEN 

002091 ph := phNoSel 

002092 ELSE 

002093 ph := phSel Cant; 

002094 process. Stop( ph) 

002095 {$I1FC fTrace}EP; {$ENDC} 

002096 END; 

002097 

002098 

002099 {$$ sRes} 

002100 PROCEDURE {TSel ection. }Desel ect; 

002101 VAR selection: TSelection; 

002102 BEGIN 

002103 {$I1FC fTrace}BP(7); {$ENDC} 

002104 SELF. panel. Highlight(SELF, hOnToOff); 

002105 selection := SELF. FreedAndRepl acedBy( SELF. view. NoSel ecti on) 
002106 {$I1FC fTrace}EP; {$ENDC} 

002107 END; 
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{$S SgABCcl d} 
PROCEDURE {TSel ection. }DrawGhost; 
BEGIN 

{$I FC fTrace}BP(7); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 


{$$ sRes} 


PROCEDURE {TSelection. }DoKey{(ascii: CHAR; keycap: Byte; shiftKey, appleKey, optionKey: BOOLEAN) }; 


VAR cmdNumber: TCmdNumber 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
1F appl eKey THEN 
BEGIN 
SELF. window. SetupMenus; 
cmdNumber := menuBar. CmdKey(ascii); 
SELF. wi ndow. DoCommand(cmdNumber ) 
END 
ELSE 
IF currentDocument = clipboard THEN 
process. Stop( phEditClip) 
ELSE 
[F SELF. kind = nothingKind THEN 
process. Stop( phNoSel ) 
ELSE 
BEGIN 
CASE ORD( ascii) OF 
ascArwDown: 
SELF. KeyEnter(0, 1); 
ascArwleft: 
SELF. KeyEnter(-1, 0); 
ascArwrRi ght: 
SELF. KeyEnter(1, 0); 
ascArwUp: 
SELF. KeyEnter(0, -1); 
ascClear: 
SELF. KeyCl ear; 
ascEnter: 
SELF. KeyEnter(0, 0); 
OTHERW SE 
CASE ORD( ascii) OF 
ascBackspace: 
IF shiftKey THEN 
SELF. KeyForward( appl eKey) 
ELSE 
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SELF. KeyBack( appl eKey); 
ascReturn: 
SELF. KeyReturn; 
ascTab: 
SELF. KeyTab(shiftKey); 
OTHERW SE 
SELF. KeyChar( ascii); 
END; 
END; 
1F ORD( ascii) <> ascClear THEN 
process. RememberCommand(uKeyDown); {clear is special } 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSelection. }GetHysteresis{(VAR hysterPt: Point)}; 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
SetPt(hysterPt, stdHHysteresis, stdVHysteresis); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$S SgABCpri } 
PROCEDURE {TSel ection. }HaveView{(view: TView)};: 
BEGIN 

{$IFC fTrace}BP(7); {$ENDC} 

SELF.view := view 

IF SELF.coSelection <> NIL THEN 

SELF. coSel ection. HaveVi ew( vi ew) 

{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TSelection. }Hi ghlight{(highTransit: THighTransit) }; 
BEGIN 

{$IFC fTrace}BP(7); {$ENDC} 

[F SELF.coSelection <> NIL THEN 

SELF. coSelection. Hi ghlight(highTransit); 

{$1FC fTrace}EP; {$ENDC} 

END; 


{$$ sRes} 
PROCEDURE {TSelection. }Il dl eBegin{(centi Seconds: LONGI NT) }; 
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BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF SELF.coSelection <> NIL THEN 
SELF. coSelection. I dl eBegin(centi Seconds) 
ELSE 
SELF. window. | dl eBegi n(centi Seconds) 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSel ection. }l dl eContinue{(centiSeconds: LONGI NT) }; 
BEGIN 
{$1FC fTrace}BP(5); {$ENDC} 
IF SELF.coSelection <> NIL THEN 
SELF. coSelection. | dl eConti nue(centi Seconds) 
ELSE 
SELF. window. | dl eConti nue(centi Seconds); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSel ection. }l dl eEnd{(centi Seconds: LONGI NT) }; 
BEGIN 
{$1 FC fTrace}BP(7); {$ENDC} 
IF SELF.coSelection <> NIL THEN 
SELF. coSelection. | dl eEnd(centi Seconds) 
ELSE 
SELF. window. | dl eEnd(centi Seconds); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSelection. }KeyBack{(f Word: BOOLEAN) }; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF SELF.coSelection <> NIL THEN 
SELF. coSel ection. KeyBack(f Word) 
ELSE 
SELF. Cant DoCmd( uBackspace); 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$S sRes} 
PROCEDURE {TSelection. }KeyChar{(ch: CHAR) }; 
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002252 BEGIN 

002253 {$I1FC fTrace}BP(7); {$ENDC} 

002254 IF SELF.coSelection <> NIL THEN 

002255 SELF. coSelection, KeyChar(ch) 

002256 ELSE 

002257 SELF. Cant DoCmd( uTypi ng) 

002258 {$1FC fTrace}EP; {$ENDC} 

002259 END; 

002260 

002261 

002262 {$$ sRes} 

002263 PROCEDURE {TSelection. }KeyCl ear 

002264 VAR dummy: BOOLEAN 

002265 BEGIN 

002266 {$I1FC fTrace}BP(7); {$ENDC} 

002267 IF SELF.coSelection <> NIL THEN 

002268 SELF. coSelection. KeyCl ear 

002269 ELSE IF (menubar. GetCmdName(uClear, NIL)) {there is a CLEAR menu item} AND 
002270 (SELF.CanDoCommand(uClear, dummy)) {the selection says it can do it} THEN 
002271 BEGIN {make believe the user chose the menu item} 
002272 menuBar. Hi ghl i ght Menu(uCl ear) 

002273 SELF. wi ndow. DoCommand(uCl ear) 

002274 END 

002275 ELSE 

002276 BEGIN 

002277 SELF. Cant DoCmd(uCl ear); 

002278 process, Remember Command(uCl ear); 

002279 END; 

002280 {$I1FC fTrace}EP; {$ENDC} 

002281 END; 

002282 

002283 

002284 {$$ sRes} 

002285 PROCEDURE {TSelection. }KeyEnter{(dh, dv: INTEGER) }; 
002286 BEGIN 

002287 {$I1FC fTrace}BP(7); {$ENDC} 

002288 IF SELF.coSelection <> NIL THEN 

002289 SELF. coSelection. KeyEnter(dh, dv) 

002290 ELSE 

002291 SELF. Cant DoCmd( uEnter); 

002292 {$IFC fTrace}EP; {$ENDC} 

002293 END; 

002294 

002295 

002296 {$$ sRes} 

002297 PROCEDURE {TSelection. }KeyForward{(fWord: BOOLEAN) }; 
002298 BEGIN 

002299 {$I1FC fTrace}BP(7); {$ENDC} 
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002300 
002301 
002302 
002303 
002304 
002305 
002306 
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002336 
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002339 
002340 
002341 
002342 
002343 
002344 
002345 
002346 
002347 
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IF SELF.coSelection <> NIL THEN 
SELF. coSel ection. KeyForward(f Word) 
ELSE 
SELF. Cant DoCmd( uForwardSpace) 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$S sRes} 
PROCEDURE {TSelection. }KeyPause 
BEGIN 

{$I FC fTrace}BP(7); {$ENDC} 

IF SELF.coSelection <> NIL THEN 

SELF. coSelection, KeyPause 

{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSelection. }KeyReturn; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF SELF.coSelection <> NIL THEN 
SELF. coSelection. KeyReturn 
ELSE 
SELF. Cant DoCmd( uRet urn) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSelection. }KeyTab{(fBackward: BOOLEAN) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
IF SELF.coSelection <> NIL THEN 
SELF. coSel ection. KeyTab( f Backward) 
ELSE 
SELF. Cant DoCmd( uTab); 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$S SgABCres} 
PROCEDURE {TSel ection. }MarkChanged 
VAR delta: INTEGER 
BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
1F SELF. panel. window = current Window THEN 
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BEGIN 
1F currentWindow.lastCmd = NIL THEN 
delta := 1 
ELSE 
1F current Window.|astCmd. doing THEN 
delta := 1 
ELSE 
delta :=-1: 
current Window. changes := currentWindow. changes + delta; 


IF boundDocument = currentDocument THEN 
WITH boundDocument DO 


dataSegment. changes := dataSegment.changes + delta; 
END; 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$$ sRes} 
PROCEDURE {TSel ection. }}MousePress{( mouseLPt: LPoint) }; 
BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 
IF SELF.coSelection <> NIL THEN 
SELF. coSelection. MousePress(mouseLPt); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSel ection. }MouseMove{(mouseLPt: LPoint) }: 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 

IF SELF.coSelection <> NIL THEN 

SELF. coSelection., MouseMove( mouseLPt); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TSel ection. }MouseRel ease 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 

IF SELF.coSelection <> NIL THEN 

SELF. coSelection, MouseRel ease 

{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$S SgABCcl d} 
PROCEDURE {TSel ection. }MoveBackToAnchor; {dest panel of cross-panel drag refused DoRecei ve} 
BEGIN 
{$1 FC fTrace}BP(7); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 


{$$ sRes} 
FUNCTION {TSelection. }NewCommand{(cmdNumber: TCmdNumber): TCommand}; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
IF SELF.coSelection <> NIL THEN 
NewCommand : = SELF.coSel ection. NewCommand( cmdNumber) 
ELSE 
NewCommand : = SELF. window. NewCommand( cmdNumber ) 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$S sRes} 
PROCEDURE {TSelection. }PerformCommand{(command: TCommand; cmdPhase: TCmdPhase) }; {+swt} 
BEGIN 

{$I FC fTrace}BP(7); {$ENDC} 

command. doing := (cmdPhase <> undoPhase); 

command. Perf orm(cmdPhase) ; 

{$1FC fTrace}EP; {$ENDC} 


END; 

{$$ sRes} 

PROCEDURE {TSelection. }Restore; {SELF should be undoSel ection} 
VAR selection: TSelection; 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
selection := SELF. panel.selection. FreedAndRepl acedBy( 

TSelection(SELF. panel. undoSel ection, Clone(SELF.Heap))); {$} 

selection := SELF. panel. undoSel ection, FreedAndRepl aceBy( SELF. vi ew. NoSel ecti on) 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$$ sRes} 


PROCEDURE {TSel ection. }Reveal (asMuchAsPossi ble: BOOLEAN) 
TYPE TXLRect = PACKED ARRAY [1..SIZEOF(LRect)] OF CHAR 


VAR Ir: LRect; 
hMi n: INTEGER; 
vMin: INTEGER; 
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002444 BEGIN 

002445 {$I1FC fTrace}BP(7); {$ENDC} 

002446 IF SELF.coSelection <> NIL THEN 

002447 SELF. coSel ection. Reveal (as MuchAsPossi bl e) 
002448 ELSE 

002449 BEGIN 

002450 lr := SELF. boundLRect; 

002451 IF TXLRect(Ir) <> TXLRect(hugeLRect) THEN 
002452 BEGIN 

002453 1F NOT asMuchAsPossible THEN 

002454 BEGIN 
002455 hMi n 
002456 vMin 
002457 END 
002458 ELSE 
002459 WTH Ir DO 
002460 BEGIN 
002461 hMi n 
002462 vMin 
002463 END; 
002464 SELF. panel. RevealLRect(Ir, hMin, vMin) 

002465 END; 

002466 END; 

002467 {$I1FC fTrace}EP; {$ENDC} 

002468 END; 

002469 

002470 

002471 {$$ sRes} 

002472 PROCEDURE {TSel ection. }Save 

002473 VAR selection: TSelection; 

002474 BEGIN 

002475 {$I1FC fTrace}BP(7); {$ENDC} 

002476 selection := SELF. panel. undoSel ection. FreedAndRepl acedBy(TSelection( SELF. Cl one( SELF. Heap) ) ) 
002477 {$IFC fTrace}EP; {$ENDC} 

002478 END; 

002479 

002480 

002481 {$$ sRes} 

002482 PROCEDURE {TSelection. }Select Paragraphs 

002483 BEGIN 

002484 {$I1FC fTrace}BP(7); {$ENDC} 

002485 IF SELF.coSelection <> NIL THEN 

002486 SELF. coSelection. Select Paragraphs 

002487 {$I1FC fTrace}EP; {$ENDC} 

002488 END; 

002489 

002490 

002491 {$8 SgABCi ni } 


30; 
20; 


Min( MAXINT, right - left + 6 
Min( MAXINT, bottom- top + 4 


Apple Lisa ToolKit 3.0 Source Code Listing -- 218 of 1012 


Apple Lisa Computer Technical Information 


002492 BEGIN 

002493 cSelection := THISCLASS: 
002494 END; 

002495 {$S SgABCres} 
002496 

002497 

002498 

002499 

002500 

002501 

002502 

002503 

002504 

002505 

002506 


End of File -- Lines: 2506 Characters: 78752 
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000001 {INCLUDE FILE UABC4 -- IMPLEMENTATION OF UABC} 

000002 {Copyright 1983, 1984, Apple Computer, Inc. } 

000003 

000004 {TWi ndow- TDi al ogBox- TMenuBar- TFont } 
000005 

000006 


000007 {changed 05/07/84 17:45 Fixed (hopefully) a bug in binary search of InAll MenusDo. } 
000008 
000009 METHODS OF TWindow; 


000010 

000011 

000012 {$8 SgABCi ni } 

000013 FUNCTION {TWindow. }CREATE{(object: TObject; heap: THeap; itsWmgrlD: TWndowlD; itsResizability: BOOLEAN) 
000014 : TWindow}; 
000015 VAR pWi ndow: Wi ndowPtr; 

000016 panels: TList; 

000017 info: Wi ndowl nfo; 

000018 BEGIN 

000019 {$I1FC fTrace}BP(7); {$ENDC} 

000020 IF object = NIL THEN 

000021 object := NewObject(heap, THISCLASS); 
000022 SELF := TWindow(obj ect); 

000023 

000024 Get Wi ndI nfo(WindowPtr(itsWmgrlD), info); 
000025 

000026 WITH SELF DO 

000027 BEGIN 

000028 panel Tree := NIL; 

000029 dialogBox := NIL; 

000030 selectPanel := NIL; 

000031 undoSel Panel := NIL; 

000032 clickPanel := NIL; 

000033 undoClickPanel := NIL; 

000034 wmgrlD := itsWmgrlD; 

000035 isResizable := itsResizability; 
000036 believeWmgr := info. visible; 

000037 changes := 0; 

000038 selectWindow := SELF ; 

000039 undoSel Window := NIL; {+SW+} 

000040 lastCmd := NIL; 

000041 parentBranch := NIL; 

000042 pgSzOK : = TRUE; {client can explicitly set this to FALSE if bothered} 
000043 pgRgOK : = TRUE; {client can explicitly set this to FALSE if does own page-rangi ng} 
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000044 panel ToPrint := NIL; 

000045 objectToFree := NIL; {+SW+} 
000046 END; 

000047 

000048 panels := TList.CREATE(NIL, heap, 1) 
000049 SELF. panels := panels; 

000050 

000051 1F itsWmgrlD = 0 THEN 

000052 SELF. Seti nnerRect(zeroRect) 
000053 ELSE 

000054 BEGIN 

000055 pWi ndow := POINTER(itsWmgrl D); 
000056 SELF. Set nner Rect ( pWi ndow’. port Rect); 
000057 END; 

000058 

000059 {$H-} SELF. maxi nnerSize := Point(FDiagRect(SELF.innerRect)); {$H+} 
000060 {$I1FC fTrace}EP; {$ENDC} 

000061 END; 

000062 {$S SgABCres} 

000063 

000064 

000065 {$8 SgABCi ni } 

000066 PROCEDURE {TWindow. }Free 

000067 BEGIN 

000068 {$I FC fTrace}BP(7); {$ENDC} 

000069 Free( SELF. dial ogBox); 

000070 SELF. panels. Free 

000071 TArea. Free 

000072 {$I1FC fTrace}EP; {$ENDC} 

000073 END; 

000074 {$S SgABCres} 

000075 

000076 

000077 {$1 FC fDebugMet hods} 

000078 {$8 SgABCdbg} 

000079 PROCEDURE {TWindow. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
000080 BEGIN 

000081 TArea. Fields( Field) 

000082 Field(' panels: TList'); 

000083 Field(' panel Tree: TArea' ) 

000084 Field('dialogBox: TDi al ogBox' ) 
000085 Field('selectPanel: TPanel'); 

000086 Field('undoSel Panel: TPanel') 

000087 Field('clickPanel: TPanel') 

000088 Field('undoClickPanel: TPanel'); 
000089 Field('selectWndow: TWindow' ) 
000090 Field('undoSel Window: TWindow'); {+SW+} 
000091 Field('wmgriD: Ptr'); 
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000092 
000093 
000094 
000095 
000096 
000097 
000098 
000099 
000100 
000101 
000102 
000103 
000104 
000105 
000106 
000107 
000108 
000109 
000110 
000111 
000112 
000113 
000114 
000115 
000116 
000117 
000118 
000119 
000120 
000121 
000122 
000123 
000124 
000125 
000126 
000127 
000128 
000129 
000130 
000131 
000132 
000133 
000134 
000135 
000136 
000137 
000138 
000139 


{$8 


{$8 


{$8 
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Field('isResizable: BOOLEAN'); 

Field('believeWmgr: BOOLEAN’); 

Field(' maxi nnerSize: Point'); 

Field('changes: LONGI NT'); 

Field('lastCmd: TCommand' ); 

Field(CONCAT('printerMetrics: RECORD paperRect: Rect; printRect: Rect;', 
‘res: Point; reserve: ARRAY[0..3] OF INTEGER END')); 

Field('pgSzOK: BOOLEAN' ) 

Field('pgRgOK: BOOLEAN' ) 

Field(' panel ToPrint: TPanel'); 

Field('objectToFree: TObject'); {+SW+} 


Field(''); 
END; 
{$S SgABCres} 
{$ENDC} 
SgABCcl d} 
PROCEDURE {TWindow. }Abort Event 
BEGIN 
{$1 FC fTrace}BP( 9); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 
SgABCres} 
SgABCpri } 


PROCEDURE {TWindow. }AcceptNewPrintingl nfo{(document: TDocManager; prReserve: TPrReserve) }; 
VARs: TListScanner 
panel: TPanel: 
BEGIN 
{$1 FC fTrace}BP( 9); {$ENDC} 
SELF.selectPanel.selection. MarkChanged 
IF document = clipboard THEN {first, stuff the revised print record back in document} 
clipPrintPref := prReserve 
ELSE 
document. dataSegment. preludePtr~*. printPref := prReserve 
SELF. Get Printer Metrics 
s := SELF. panels. Scanner 
WHILE s.Scan(panel) DO 
panel. current Vi ew. React ToPrinterChange; {tell each view that printer style changed} 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S sStartup} 
PROCEDURE {TWindow. }Activate; {assumes we are focused on the window already} 
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000140 BEGIN 

000141 {$I1FC fTrace}BP(7); {$ENDC} 

000142 1F NOT SELF. believeWmgr THEN {is this needed????} 
000143 SELF. Resi ze( FALSE); 

000144 

000145 SELF. Update( TRUE); {force update in case just opened from an icon} 
000146 current Window := SELF: 

000147 

000148 {NOTE: currentDocument has already been set} 
000149 activeWindowl D := SELF. wmgrl D; 

000150 SELF. Refresh([rFrame], hDimTo0On); 

000151 IF currentDocument <> clipboard then 

000152 SELF. ChkPr Mismatch; 

000153 SELF. PickStdCursor 

000154 clipboard. Inspect; 

000155 IF SELF.dialogBox <> NIL THEN 

000156 SELF. dial ogBox. Appear 

000157 IF currentDocument. pendingNote <> 0 THEN 
000158 BEGIN 

000159 process. Note(current Document. pendingNote); 
000160 current Document. pendingNote := 0; 

000161 END; 

000162 

000163 {reset undo} 

000164 

000165 SELF. LoadMenuBar 

000166 menuBar. Draw 

000167 

000168 SetPt(clickState. where, -MAXINT, - MAXI NT) 
000169 {$1FC fTrace}EP; {$ENDC} 

000170 END; 

000171 {$S SgABCres} 

000172 

000173 

000174 {$$ Override} 

000175 PROCEDURE {TW ndow. }Bl ankStati onery; 

000176 VAR panel: TPanel 

000177 view: TVi ew 

000178 BEGIN 

000179 {$I1FC fTrace}BP(7); {$ENDC} 

000180 panel := TPanel. CREATE(NIL, SELF. Heap, SELF, 0, 0, [aScroll, aSplit], [aScroll, aSplit]); 
000181 view := panel. NewStatusView(NIL, zeroLRect); 
000182 {$1FC fTrace}EP; {$ENDC} 

000183 END; 

000184 {$S SgABCres} 

000185 

000186 

000187 {$$ sCommand} 
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FUNCTION {TWindow. }CanDoCommand{(cmdNumber: TCmdNumber; VAR checkl t: BOOLEAN): BOOLEAN}; 
BEGIN 

{$1FC fTrace}BP(6); {$ENDC} 

CanDoCommand := current Window. CanDoStdCommand(cmdNumber, checklt); 

{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ sCommand} 
FUNCTION {TWindow. }CanDoStdCommand{(cmdNumber: TCmdNumber; VAR checklt: BOOLEAN): BOOLEAN}; 


VAR previ ewMode: TPreviewMode 
couldPrint: BOOLEAN 
panel ToUse: TPanel; 

BEGIN 


{$1FC fTrace}BP( 6); {$ENDC} 
CanDoStdCommand := FALSE; 


couldPrint := (SELF.panelToPrint <> NIL) 
IF couldPrint THEN 
IF SELF.selectPanel.view.isPrintable THEN 
panel ToUse := SELF.sel ect Panel 
ELS 
panel ToUse := SELF. panel ToPri nt; 


IF couldPrint THEN 
previewMode := panel ToUse. previ ewMode 


CASE cmdNumber OF 
{File/ Print} 


uSetAll Aside, uSetAside, uSetClipAside 
CanDoStdCommand := TRUE; 


uPutAway, uRevert Version 
CanDoStdCommand := clipboard. window <> SELF; 


uSaveVersion: 
CanDoStdCommand := (clipboard. window <> SELF) AND 
(currentDocument.files.shouldTool Save OR 
NOT current Document. openedAsTool ); 


{$1FC LibraryVersion <= 20} 


uPrFmt, uPrint: 
CanDoStdCommand := onDesktop AND (SELF. dialogBox = NIL) AND couldPrint; 


{$ELSEC} 


uPrFmt, uPrint, uPrintAsls: 
CanDoStdCommand := onDesktop AND (SELF. dialogBox = NIL) AND couldPrint; 
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000242 
000243 
000244 
000245 
000246 
000247 
000248 
000249 
000250 
000251 
000252 
000253 
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{$ENDC} 


uPr Monitor: 
CanDoStdCommand := onDesktop AND (SELF.dialogBox = NIL); {**temporary**} 


{Edit} 


uUndoLast: 
1F SELF.lastCmd = NIL THEN 
CanDoStdCommand := FALSE 
ELSE 
CanDoStdCommand := SELF.|astCmd. undoabl e; 


{Page Layout} 


uPrvwMargins, uPrvwBreaks, uPrvwOff, uAddColumnStrip, uAddRowStri p: 
IF couldPrint THEN 
BEGIN 
CanDoStdCommand := TRUE; {or they wouldnt've been in the phrase file} 
CASE cmdNumber OF 
uPrvwMar gins: 


checklt := previewMode = mPrvwMargins 
uPrvwBreaks: 
checklt := previewMode = mPrvwBreaks 
uPrvwof f: 
checklt := previewMode = mPrvw0ff; 
END; 
END; 


uDesi gnPages: 
IF couldPrint THEN 
BEGIN 
CanDoStdCommand := (SELF. dialogBox = NIL) 
checklt := (SELF.dialogBox = panel ToUse. view. print Manager. | ayoutDi al ogBox) 
AND (SELF. dialogBox <> NIL); 
END; 


uSetHorzBreak, uSetVertBreak, uClearBreaks: 
CanDoStdCommand := SELF.clickPanel. view. isPrintable; 


uShowFull Size, uReduce70Pct, uReduceToFit: 
CanDoStdCommand := fExperi menting; {**temporary**} 


uRiseVertically, uRiseHorizontal ly: 
IF couldPrint THEN 


BEGIN 
CanDoStdCommand := TRUE; 
checklt := panel ToUse. view. printManager. pageRiseDirection = 


Apple Lisa ToolKit 3.0 Source Code Listing -- 225 of 1012 


000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
000295 
000296 
000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 


Apple Lisa Computer Technical 


Information 


VHSelect(cmdNumber = 


END 
ELSE 

CanDoStdCommand := FALSE; 
{$1 FC f DbgABC} 
{Debug} 


uReportEvents, uCountHeap, uChecklIndices, 
uExperimenting, uDumpGlobals, uDumpPrel ude 
uMainScramble, uDocScramble: 
BEGIN 
CanDoStdCommand := TRUE; 
CASE cmdNumber OF 
uReportEvents: 


checklt := eventDebug 
uCount Heap: 
checklt := fCountHeap; 
uChecklI ndices: 
checklt := fCheckI ndices 
uExperi menting: 
checklt := fExperi menting 
uMai nScrambl e: 
checklt := THz( mai nHeap) *. f Scramble; 


uDocScrambl e: 
1F currentDocument <> NIL THEN 
checklit 
ELSE 
CanDoStdCommand := FALSE; 
END; 
END; 


uReptGarbage, uFreeGarbage: 
CanDoStdCommand := clipboard. window <> SELF; 
{$ENDC} 


END; 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$$ SgABCres} 


{$S sStartup} 
PROCEDURE {TWindow. }ChkPr Mismatch; 
VAR styleDidChange: BOOLEAN 


prPrf Alias: TPrPrfAlias; 
Si TListScanner; 
panel: TPanel; 
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:= THz(current Document. docHeap) *.fScrambl e 
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error: INTEGER; 
document: TDocManager; 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 

IF currentDocument <> NIL THEN 
document := current Document 

ELSE 
document := boundDocument 

IF document = clipboard THEN 
prPrfAlias.reserve := clipPrintPref 


ELSE 
prPrfAlias. reserve := document. dataSegment. preludePtr%. Print Pref; 
{$1FC libraryVersion <= 20} { PEPSI } 
[F FPrArbRqd(prPrfAlias.prPrf) THEN 
BEGIN 
PrArbDig(error, prPrfAlias. prPrf, styl eDidChange) 
{$ELSEC} { SPRING } 
1F NOT fPrPrfValid(prPrfAlias.prPrf) THEN 
BEGIN 


PrPrfDig(prPrfAlias. prPrf, styleDidChange, NOT SELF. pgSzOK) 
{$ENDC} 


IF styl eDidChange THEN 
SELF. Accept NewPri ntingl nfo(document, prPrf Alias. reserve) 
END; 
{?? Do we need to worry about refreshing the window when needed? } 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ sCommand} 
PROCEDURE {TWindow. }CommitLast 
VAR |astCmd: TCommand 
lastView: TView; {+SW+} 
selection: TSelection; {+SW+} 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
1F SELF <> current Window THEN 
current Window. Commi tLast 
ELSE 
BEGIN 
lastCmd := SELF. |] astCmd; 
IF lastCmd <> NIL THEN 
BEGIN 
IF lastCmd. doing THEN 
last Cmd. Commit; 
( **# RF 


IF lastCmd.image <> NIL THEN 
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000380 BEGIN 

000381 lastView := lastCmd.i mage. view 
000382 selection := lastView. panel. undoSel ection. FreedAndRepl acedBy(l ast Vi ew. NoSel ecti on) 
000383 END; 

000384 *****) 

000385 lastCmd, Free; 

000386 SELF.lastCmd := NIL; 

000387 END; 

000388 END; 

000389 {$1FC fTrace}EP; {$ENDC} 

000390 END; 

000391 

000392 

000393 {$S sStartup} 

000394 FUNCTION {TWindow. }CursorFeedback{: TCursorNumber}; 
000395 VAR s: TListScanner; 

000396 panel: TPanel: 

000397 cursorNumber: TCursorNumber 

000398 mousePt: Point; 

000399 BEGIN 

000400 {$1 FC fTrace}BP( 3); {$ENDC} 

000401 PushFocus 

000402 SELF. Focus 

000403 cursorNumber := noCursor 

000404 Get Mouse( mousePt ) 

000405 IF RectHasPt(SELF.innerRect, mousePt) THEN 
000406 IF SELF.isResizable AND fGrowHit(mousePt) THEN 
000407 cursorNumber := arrowCursor 

000408 ELSE 

000409 BEGIN 

000410 s := SELF. panels. Scanner; 

000411 WHILE s.Scan(panel) DO 

000412 BEGIN 

000413 cursorNumber := panel. CursorAt( mousePt) 
000414 1F cursorNumber <> noCursor THEN 
000415 s. Done; 

000416 END; 

000417 1F cursorNumber = noCursor THEN 

000418 cursorNumber := arrowCursor 

000419 END; 

000420 PopFocus; 

000421 CursorFeedback := cursorNumber 

000422 {$1FC fTrace}EP; {$ENDC} 

000423 END; 

000424 

000425 

000426 {$S SgABCcl d} 

000427 PROCEDURE {TWndow. }}Deactivate; {assumes we are focused on the window already} 
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BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
(FR RRR RRR KKK KR RK ERE these lines are needed for the Extra Window feature *) 

IF current Window <> SELF THEN 
BEGIN 
GiveControl(event); {This must be last} 
{$1 FC fTrace}EP; {$ENDC} 
EXIT( Deactivate); 


(* AAR EAA EKEK KERR EE EERE) 
SELF. Commi tLast; 


[F SELF.dialogBox <> NIL THEN 
SELF. dial ogBox. Disappear 


activeWindowlD := 0; {must precede StashPicture and Refresh so scrol 
SELF. Refresh([rFrame], hOnToDim); {do first to give user feedback} 
SELF. StashPicture( hOfftoDi m) 


bars are white} 


[F (SELF. wmgrid <> ORD(scrapFolder)) AND (event.fromProcess <> myProcessID) THEN 


clipboard. Publicize 
focusArea := NIL; 


[F NOT inBackground THEN 
current Document. Deactivate; 


GiveControl(event); {This must be last} 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$$ sCommand} 
PROCEDURE {TWindow. }DoCommand{(cmdNumber: TCmdNumber) }; 
VAR command: TCommand; 
BEGIN 
{$1FC fTrace}BP(7); {$ENDC} 
1F cmdNumber <> 0 THEN 
BEGIN 
1F cmdNumber = uUndoLast THEN 
SELF. UndoLast 


ELSE 
BEGIN 
command := SELF.selectPanel.sel ection. NewCommand(cmdNumber); 
1F command <> NIL THEN {NOTE: If NewCommand Frees SELF (this window), it MUST return NIL} 


SELF. PerformCommand( command); 
END; 
process, Remember Command(cmdNumber); 
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END; 
menuBar. EndCmd: 
{$I1FC fTrace}EP; {$ENDC} 


END: 
{$$ sClick} 
FUNCTION {TWindow. }DownAt{(mousePt: Point): BOOLEAN}; 
VAR s: TListScanner 
panel: TPanel; 
b: BOOLEAN; 
BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
b := FALSE; 
IF RectHasPt(SELF.innerRect, mousePt) THEN 
BEGIN 
IF SELF.isResizable THEN 
IF fGrowHit(mousePt) THEN 
BEGIN 
SELF. Downl nSi zeBox( mousePt) ; 
b := TRUE: 
process, Remember Command( uResizeWi ndow); 
END; 
1F NOT b THEN 
BEGIN 
b := TRUE: 
s := SELF. panels. Scanner; 
WHILE s.Scan(panel) DO 
IF panel. DownAt(mousePt) THEN 
s. Done; 
END; 
END; 
DownAt := b; 
{$IFC fTrace}EP; {$ENDC} 
END: 
{$$ sClick} 


PROCEDURE {TWindow. }DownEventAt{( mousePt: Point) }; 
VAR clickNeighborhood: Rect; 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 


SELF. Update(TRUE); {In case an alert box was dismissed by the click} 


{ given that previous click was at (0,0), clickNeighborhood is a rectangle in which 
this click must fall for it to have a chance at being a double click } 
SetRect(clickNeighborhood, -9, -6, 9, 6); { clickNeighborhood should be a method call; 
how much flexibility is needed???? } 
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000524 

000525 IF ((event. when - clickState. when) < clickDelay) AND 

000526 (RectHasPt(clickNeighborhood, Point(FPtMinusPt( event. where, clickState. where)))) THEN 
000527 clickState.clickCount := Min(clickState.clickCount + 1, 3) 
000528 ELSE 

000529 BEGIN 

000530 clickState.clickCount := 1; 

000531 clickState.fShift := event.shiftKey; 

000532 clickState.fOption := event. codeKey; 

000533 clickState.fApple := event. appl eKey; 

000534 END; 

000535 clickState. when := event. when; 

000536 clickState. where := event. where 

000537 1F SELF. DownAt(mousePt) THEN 

000538 {$I1FC fTrace}EP; {$ENDC} 

000539 END: 

000540 

000541 

000542 {$$ sClick} 

000543 PROCEDURE {TWindow. }Downl nSizeBox{( mousePt: Point) }; 

000544 VAR ol dRect: Rect 

000545 full Rect: Rect; {includes title tab} 

000546 mi nExtent: Point: 

000547 mi nBot Ri ght: Point: 

000548 max Bot Ri ght: Point; 

000549 savePort: Graf Ptr 

000550 newBot Ri ght: Poi nt; 

000551 BEGIN 

000552 {$1FC fTrace}BP(7); {$ENDC} 

000553 oldRect := SELF.innerRect; 

000554 

000555 SELF. Get Mi nExtent(minExtent, TRUE) 

000556 mi nBotRight := Point(FPtPlusPt(oldRect.topLeft, minExtent)); 
000557 

000558 Local ToGl obal ( mi nBot Ri ght); 

000559 Local ToGl obal ( mousePt); 

000560 Local ToGl obal (ol dRect.topLeft); 

000561 Local ToGl obal (ol dRect. bot Ri ght); 

000562 maxBot Right := Point(FPtMaxPt(minBotRight, screenBits. bounds. botRi ght) ); 
000563 

000564 full Rect := oldRect; 

000565 fullRect.top := fullRect.top - dvSBox; {allow for title tab} 
000566 

000567 Get Port(savePort); 

000568 SetPort(deskPort); 

000569 ResizeFeedback( mousePt, minBotRight, maxBotRight, fullRect, dvSBox, dhSBox, dvSBox, newBotRi ght); 
000570 SetPort(savePort); 

000571 
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000572 SELF. Resi zeTo(Point(FPtMi nusPt(newBotRi ght, oldRect.topLeft))) 
000573 {$I1FC fTrace}EP; {$ENDC} 

000574 END; 

000575 

000576 

000577 {$$ sFilter} {+SW+} 

000578 PROCEDURE {TWindow. }EachActual Part {( PROCEDURE DoToObject(filteredObj: TObj ect))}; 
000579 VAR n: INTEGER; 

000580 cmdWindow: TWindow 

000581 BEGIN 

000582 {$I1FC fTrace}BP(11); {$ENDC} 

000583 {$1 FC fDbgABC} 

000584 [F SELF = current Window. dial ogBox THEN 

000585 cmdWi ndow := current Window 

000586 ELSE 

000587 cmdWindow := SELF; 

000588 

000589 IF cmdWindow.|astCmd = NIL THEN 

000590 n:= 0 

000591 ELSE 

000592 n := cmdWindow. !astCmd. cmdNumber 

000593 ABCBreak('A View or Wndow tried to filter but did not implement EachActual Part: lastCmd =', n) 
000594 {$ENDC} 

000595 {$I1FC fTrace}EP; {$ENDC} 

000596 END; 

000597 {$S SgABCres} 

000598 

000599 

000600 {$$ sFilter} 

000601 PROCEDURE {TWindow. }EachVirtual Part {( PROCEDURE DoToObj ect(filteredObj: TObject))}; 
000602 BEGIN 

000603 {$I1FC fTrace}BP(11); {$ENDC} 

000604 SELF. FilterDispatch(NIL, NIL, DoToObj ect); 

000605 {$I1FC fTrace}EP; {$ENDC} 

000606 END: 

000607 

000608 

000609 {$$ sFilter} 

000610 PROCEDURE {TWndow. }FilterAndDo{( actual Obj: TObject; PROCEDURE DoToObject(filteredObj: TObject))}; 
000611 BEGIN 

000612 {$IFC fTrace}BP(11); {$ENDC} 

000613 SELF. FilterDispatch(actual Obj, NIL, DoToObj ect); 

000614 {$1FC fTrace}EP; {$ENDC} 

000615 END; 

000616 

000617 

000618 {$$ sFilter} 

000619 PROCEDURE {TWindow. }FilterDispatch{(actual Obj: TObject; image: Tl mage 
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000620 PROCEDURE DoToObject(filteredObj: TObject))}; 
000621 VAR filterCommand: TCommand 

000622 filtering: BOOLEAN; 

000623 cmdWi ndow: TWi ndow 

000624 BEGIN 

000625 {$1FC fTrace}BP(11); {$ENDC} 

000626 cmdWi ndow := SELF; 

000627 IF currentWindow <> NIL THEN 

000628 1F SELF = current Window. di alogBox THEN 
000629 cmdWi ndow := current Window 

000630 

000631 filterCommand := cmdWi ndow. | ast Cmd 

000632 

000633 filtering := FALSE; 

000634 IF filterCommand <> NIL THEN 

000635 IF filterCommand. doing THEN 

000636 IF filterCommand.image <> NIL THEN 

000637 filtering := filterCommand. i mage. SeesSameAs(i mage) 
000638 

000639 IF filtering THEN 

000640 IF actual Obj <> NIL THEN 

000641 filterCommand. FilterAndDo( actual Obj, DoToObj ect) 
000642 ELSE 

000643 filterCommand. EachVirtual Part (DoToObj ect) 
000644 ELSE 

000645 IF actual Obj <> NIL THEN 

000646 DoToObj ect( actual Obj ) 

000647 ELSE 

000648 I1F image <> NIL THEN 

000649 image. EachActual Part(DoToObj ect) 

000650 ELSE 

000651 SELF. EachActual Part(DoToObj ect); 

000652 {$1FC fTrace}EP; {$ENDC} 

000653 END; 

000654 

000655 

000656 {$8 sStartup} 

000657 PROCEDURE {TWi ndow. }Focus 

000658 BEGIN 

000659 {$IFC fTrace}BP( 6); {$ENDC} 

000660 Set Port(POINTER( SELF. wmgrl D) ) 

000661 SetOrigin(0, 0) 

000662 ClipRect(thePort*%. portRect); 

000663 IF useAltVisRgn THEN 

000664 focusRgn := altVisRgn {I nstigated by TWndow.StashPicture or TClipboard. Publicize} 
000665 ELSE 

000666 focusRgn := thePort*. visRgn; 

000667 focusArea := SELF: 
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000668 {$I1FC fTrace}EP; {$ENDC} 

000669 END; 

000670 {$8 SgABCres} 

000671 

000672 

000673 {$8 sStartup} 

000674 PROCEDURE {TWindow. }Frame; 

000675 VAR growRect: Rect; 

000676 BEGIN 

000677 {$1FC fTrace}BP( 6); {$ENDC} 

000678 IF SELF.isResizable THEN 

000679 BEGIN 

000680 Get GrowRect(growRect); 

000681 IF RectlsVisible(growRect) THEN 
000682 IF SELF.IsActive THEN 

000683 Pai nt Grow 

000684 ELSE 

000685 Fill Rect(growRect, white) 
000686 END; 

000687 {$I1FC fTrace}EP; {$ENDC} 

000688 END; 

000689 {$8 SgABCres} 

000690 

000691 

000692 {$S sCldl nit} 

000693 PROCEDURE {TWindow. }Get PrinterMetrics 
000694 VAR prPrfAlias: TPrPrfAlias 
000695 prinfo: TPrinfo 

000696 tkDevice: INTEGER 

000697 document: TDoc Manager 
000698 BEGI N 

000699 {$I1FC fTrace}BP(9); {$ENDC} 

000700 IF currentDocument <> NIL THEN 

000701 document := current Document 
000702 ELSE 

000703 document := boundDocument; 

000704 IF document = clipboard THEN 

000705 prPrfAlias.reserve := clipPrintPref 
000706 ELSE 

000707 prPrfAlias. reserve := document. dataSegment. preludePtr%. print Pref; 
000708 {$IFC libraryVersion <= 20} { PE PS 
000709 PrMetrics(prPrfAlias.prPrf, prinfo) 
000710 {$ELSEC} {SPRING} 
000711 prinfo := prPrfAlias. prPrf.prinfo; {this looks odd, but the prPrf is of type prRec really} 
000712 {$ENDC} 

000713 WITH SELF. printerMetrics, prinfo DO 
000714 BEGIN 

000715 printRect := rPrintable 
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000716 paperRect := rPaper 

000717 END; 

000718 SELF. printerMetrics.res.h := prinfo. hRes 

000719 SELF. printerMetrics.res.v := prinfo. vRes 

000720 {$I1FC fTrace}EP; {$ENDC} 

000721 END; 

000722 {$S SgABCres} 

000723 

000724 

000725 {$S sStartup} 

000726 PROCEDURE {TWindow. }Get Mi nExtent{(VAR minExtent: Point; windowlsResizinglt: BOOLEAN) }; 
000727 BEGIN 

000728 {$1FC fTrace}BP(9); {$ENDC} 

000729 SELF. panel Tree. Get MinExtent(minExtent, windowlsResizinglt); 
000730 {$SIFC fTrace}EP; {$ENDC} 

000731 END; 

000732 {$S SgABCres} 

000733 

000734 

000735 {$S sRes} 

000736 PROCEDURE {TWindow. }GetTitle{(VAR title: $255)}; 

000737 VAR kludge: Str255; 

000738 BEGIN 

000739 {$I1FC fTrace}BP(7); {$ENDC} 

000740 GetFldrTitle(POINTER(SELF.wmgriD), kludge) 

000741 title := kludge; 

000742 {$1FC fTrace}EP; {$ENDC} 

000743 END; 

000744 

000745 

000746 {$S sStartup} 

000747 PROCEDURE {TWindow. }Hi ghlight{(highTransit: THighTransit) }; 
000748 PROCEDURE HilitePanel (obj: TObject); 

000749 BEGIN 

000750 TPanel (obj). Highlight(TPanel(obj).selection, highTransit); 
000751 END; 

000752 BEGIN 

000753 {$I1FC fTrace}BP(7); {$ENDC} 

000754 SELF. panels. Each(HilitePanel ) 

000755 {$I1FC fTrace}EP; {$ENDC} 

000756 END; 

000757 {$8 SgABCres} 

000758 

000759 

000760 {$S sRes} 

000761 PROCEDURE {TWindow. }I dl eBegin{(centiSeconds: LONGI NT) }; 
000762 BEGIN 

000763 {$I1FC fTrace}BP(7); {$ENDC} 
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000764 Let OthersRun; 

000765 {$I1FC fTrace}EP; {$ENDC} 

000766 END; 

000767 

000768 

000769 {$$ sRes} 

000770 PROCEDURE {TWindow. }I dl eContinue{(centi Seconds: LONGI NT) };: 
000771 BEGIN 

000772 {$1FC fTrace}BP(5); {$ENDC} 

000773 IF SELF.IsActive THEN 

000774 process. TrackCursor 

000775 Let OthersRun; 

000776 {$I1FC fTrace}EP; {$ENDC} 

000777 END; 

000778 

000779 

000780 {$$ sRes} 

000781 PROCEDURE {TWindow. }Il dl eEnd{(centiSeconds: LONGI NT) }; 
000782 BEGIN 

000783 {$I1FC fTrace}BP(7); {$ENDC} 

000784 {$I1FC fTrace}EP; {$ENDC} 

000785 END; 

000786 

000787 

000788 {$S sStartup} 

000789 FUNCTION {TWindow. }l sActive{: BOOLEAN}: 

000790 BEGIN 

000791 {$1FC fTrace}BP( 3); {$ENDC} 

000792 1F activeWindowlD = 0 THEN {nothing is active} 
000793 IsActive := FALSE 

000794 ELSE IF currentWindow = NIL THEN 

000795 BEGIN 

000796 IsActive := FALSE; 

000797 {$1 FC fDbgABC} 

000798 Writel n( CHR(7), '*#*##H RRR ERK R HERR HH!) 
000799 Writeln('In TWindow.|sActive, activeWndowlD <> 0 AND currentWndow = NIL'); 
000800 Writeln('activeWndowlD=', activeWndowlD:1, ' currentWindow=', ORD( current Window): 1) 
000801 Writel n( | *#RRRRRR RRR RRR RRR KKK!) 

000802 {$ENDC} 

000803 END 

000804 ELSE 

000805 IsActive := (SELF. wmgrlD = activeWndowlD) OR (SELF. wmgrlD = ORD(dialogFolder)); 
000806 {$1FC fTrace}EP; {$ENDC} 

000807 END; 

000808 

000809 

000810 {$S sStartup} 

000811 FUNCTION {TWindow. }I sVisible{: BOOLEAN}; 
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VAR info: Wi ndowl nfo: 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
Get Wi ndI nfo(WindowPtr( SELF. wmgrlD), info) 
IsVisible := info. visible: 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S sStartup} 
PROCEDURE {TWindow. }LoadMenuBar 


VAR i: | NTEGER; 
menul D: INTEGER; 
inClipboard: BOOLEAN; 

BEGIN 


{$I FC fTrace}BP(7); {$ENDC} 
inClipboard := activeWindowlD = ORD(scrapFolder); 


FOR i := 1 TO menuBar.numMenus DO 
BEGIN 
menul D : = wmgrMenus[i]. menul D; 
IF SELF. WantMenu(menulD, inClipboard) THEN 
menuBar.Insert(menulD, 0) 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sRes} 
PROCEDURE {TWindow. }MenuEventAt{( mousePt: Point) }; 
VAR cmdNumber: TCmdNumber 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
SELF. SetupMenus 
cmdNumber := menuBar. DownAt( mousePt ) 
IF SELF.selectPanel = NIL THEN 


{$1FC fDbgABC} ABCBreak('ObeyTheEvent: selectPanel =NIL', 0) {$ENDC} 


ELSE 
SELF. DoCommand( cmdNumber); 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$1FC LibraryVersion > 20} 
{$$ SgABCcl d} 


PROCEDURE {TWindow. }NameToPrefix(VAR error, offset: INTEGER; VAR name, prefix: TFilePath); 
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Pathname(name), Pathname( prefix)); 


BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
NameToPrefix(error, offset, WindowPtr( SELF. wmgrl D) 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$$ SgABCres} 
{$ENDC} 
{$$ sCommand} 
FUNCTION {TWindow. }NewCommand{(cmdNumber: TCmdNumber): TCommand}; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
NewCommand : = current Window. NewStdCommand(cmdNumber); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$$ sCommand} 
FUNCTION {TWindow. }NewStdCommand{(cmdNumber: TCmdNumber): TCommand}; 
VAR document: TDocManager 
didStyleChange: BOOLEAN 
{$1FC LibraryVersion <= 20} 
prPrf: TPrPrf: 
{$ENDC} 
prPrf Alias: TprPrf Alias; 
shoul dPrint: BOOLEAN 
error: INTEGER; 
str: $255; 
permCmd: BOOLEAN; { TRUE iff the command is a permanent one } 
command: TCommand: 
S! TListScanner; 
panel: TPanel: 
zoomNum: Point; 
zoomDen: Point; 
select Panel: TPanel; 
clickPanel: TPanel 
selection: TSelecti on; 
vhs: VHSel ect; 
andConti nue: BOOLEAN; 
excessBytes: INTEGER 
print Manager: TPrint Manager 
panel ToUse: TPanel; 
FUNCTION RevertConfirmed: BOOLEAN 
VAR s: TParamAl ert; 
h: INTEGER; 


p 
{$1 FC LibraryVersion <= 
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info: fs_info; 
{$ELSEC} 

i nfo: Q Info; 
{$ENDC} 

osErr: INTEGER; 

pPath: “Pat hname 

osDT: LONGI NT; 

BEGIN 


RevertConfirmed := FALSE; 


[F SELF.changes = 0 THEN 
process. Note( phUnchanged) 


ELSE 
BEGIN 
IF document.files.saveExists THEN 
BEGIN 
pPath := @document. files. volumePrefi x; 
{$1FC LibraryVersion <= 20} 
Lookup(osErr, pPath*, info); 
{$ELSEC} 
Quick _Lookup(osErr, pPath*, info); 
{$ENDC} 
IF osErr <= 0 THEN 
osDT := info. DTM 
ELSE 
osDT := -1; 
{$1FC LibraryVersion < 13} 
DTAlert(osDT, s); 
{$ELSEC} 
DTAlert(alerts, osDT, s); 
{$ENDC} 
process.ArgAlert(1, s); 
ph := phRevert 
END 
ELSE 
ph := phRevBl ank 


IF process. Caution( ph) THEN 
RevertConfirmed := TRUE; 
END; 
END; 
BEGIN 
{$1FC fTrace}BP(7); {$ENDC} 
document := current Document; 
{$IFC f DbgABC} 
[F SELF. wmgrlD <> document. window. wmgrlD THEN 
ABCbreak('In TWindow. NewStdCommand: SELF. wmgr!D <> document. window. wmgrl D; 


document =' 
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000998 
000999 
001000 
001001 
001002 
001003 
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ORD( document) ); 


{$ENDC} 
selectPanel := SELF.sel ect Panel 
clickPanel := SELF.clickPanel 


selection := selectPanel.sel ection; 


IF selectPanel.view.isPrintable THEN 
panel ToUse := select Panel 
ELSE 
panel ToUse := SELF. panel ToPri nt; 
error := 0; 
NewStdCommand := NIL; {the default return value} 
permCmd := FALSE; {if set to TRUE, make a permanent command obj ect} 
allowAbort := TRUE; {?2?? should we assume this ???} 


CASE cmdNumber OF 


{File/ Print Menu} 
uSetAll Aside: 
BEGIN 
SELF. Commit Last; 
DoFilingCmd(cmdCl osAll); 
permCmd := TRUE; 
END; 
uSetAside, uSetClipAside 
BEGIN 
SELF. Commit Last; 
DoFilingCmd(cmdCl ose); 
permCmd := TRUE; 
END; 
uPutAway, uSaveVersion: {must be the active window to do this} 
BEGIN 
andContinue := cmdNumber = uSaveVersi on; 


SELF. Commi tLast; 
IF andContinue THEN 
excessBytes := docExcess 
ELSE 
excessBytes := 0; 
document. ConserveMemory(excessBytes, TRUE {do GC}) 


IF (document. window. changes <> 0) AND 
(document.files.shouldTool Save OR NOT document. openedAsTool) THEN 
BEGIN 
process. Begi nWait(phSavi ng); 
document. SaveVersion(error, document.files.volumePrefix, andConti nue); 
process. EndWait; 
END 
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001049 
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001051 
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ELSE 1F andContinue THEN 
process, Note( phUnchanged) ; 
{shouldn't we put up a message on Save & Put Away even if document is unchanged???} 


IF (error <= 0) AND NOT andConti nue THEN {*** some cases worse! ***} 
BEGIN 
Tell Filer(error, docClosd, docPutBack, POI NTER(activeW ndowl D)); 
IF error > 0 THEN 


BEGIN 
ABCBreak('TellFiler', error); 
error := 0; 
END; 
closedDocument := document 
closedBySuspend := FALSE; 
END; 


{do something if there was an error} 

IF error = erAborted THEN 
process. Stop( phTer mi nat ed) 

ELSE IF error > 0 THEN 
process. Stop( phCant Save); 


error := 0; {we already put up the alert} 
permCmd := TRUE; 
END; 


uRevert Version: 
IF RevertConfirmed THEN 

BEGIN 

document. Revert Version(error, activeW ndowl D) 

{do something if there was an error} 

IF error = erAborted THEN 
process. Stop( phTer mi nat ed) 

ELSE |F error > 0 THEN 
BEGIN 
process, Stop( phCant Revert); 
process. Complete(FALSE); {nothing else to do: we unbound out data segments} 


END; 
error := 0; {we already put up the alert} 
permCmd := TRUE; {no need to CommitLast} 
END; {long-standing commented-out code now out} 
uPr Fmt: 
BEGIN 


1F document = clipboard THEN 

prPrfAlias.reserve := clipPrintPref 
ELSE 

prPrfAlias. reserve := document. dataSegment. prel udePtr%. print Pref; 
PushFocus; 
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{$1FC libraryVersion <= 20} { PE PS 
PrPrfDig(error, prPrfAlias. prPrf, didStyleChange) 
{$ELSEC} { SPRING } 
PrPrfDig(prPrfAlias. prPrf, didStyleChange, NOT SELF. pgSzOK); 
{$ENDC} 
PopFocus; 
IF didStyleChange THEN 
BEGIN 
SELF. Accept NewPrintingl nfo(document, prPrfAlias. reserve) 
permCmd := TRUE; 
END; 
END; 
uPrint: 
SELF. Print( panel ToUse, NOT SELF. pgRgOK, FALSE {put up dialog} ) 
uPrintAsls: 
SELF. Print(panelToUse, TRUE {suppress page range}, TRUE {suppress dial og}) 
uPr Monitor: 
BEGIN 
PushFocus; 
{$1FC libraryVersion <= 20} { PEPSI } 
PrBgdDi g(error, TRUE); 
{$ELSEC} { SPRING } 
Pr BgdDl g; 
{$ENDC} 
PopFocus; 
END; 
{Zooming & previewing pages} {some or all of these must become command obj ects} 


uPrvwMar gins: 
panel ToUse. Previ ew( mPrvwMar gins); 


uPrvwBreaks: 
panel ToUse. Previ ew( mPrvwBreaks); 


uPrvwof f: 
panel ToUse. Previ ew( mPrvwoOf f ) 


uDesi gnPages: 
BEGIN 
printManager := panel ToUse. view. print Manager 
IF printManager <> NIL THEN 

print Manager. Enter PageEdit; 

END; 


uRiseVertically, 
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001100 uRi seHori zontal ly: 

001101 BEGIN 

001102 1F cmdNumber = uRiseVertically THEN 

001103 panel ToUse. view. print Manager. pageRiseDirection := v 
001104 ELSE 

001105 panel ToUse. view. printManager. pageRiseDirection := h; 
001106 IF panel ToUse. previewMode = mPrvwMargins THEN 
001107 panel ToUse. I nvalidate; 

001108 END; 

001109 

001110 uAddCol umnStri p, 

001111 uAddRowSt rip: 

001112 BEGIN 

001113 1F cmdNumber = uAddColumnStrip THEN 

001114 vhs := v 

001115 ELSE 

001116 vhs := h} 

001117 panel ToUse. current View. AddStri pOf Pages( vhs); 
001118 END; 

001119 

001120 uShowFul | Size: 

001121 BEGIN 

001122 SetPt(zoomNum, 1, 1); 

001123 selectPanel.SetZoomFactor(zoomNum, zoomNum); {++ should this be panel ToUse?? ++} 
001124 selectPanel.Invalidate: 

001125 END; 

001126 

001127 uReduce70Pct: 

001128 BEGIN 

001129 WITH selectPanel.zoomFactor DO 

001130 IF numerator. h = 1 THEN 

001131 BEGIN 

001132 zoomNumh := 7; 

001133 zoomDen.h := denominator.h * 10; 
001134 zoomNumv := 7; 

001135 zoomDen.v := denominator.v * 10; 
001136 END 

001137 ELSE {numerator not 1, must be 7} 

001138 BEGIN 

001139 zoomNumh := 1; 

001140 zoomDen.h := denominator.h DIV 5: 
001141 zoomNumv := 1; 

001142 zoomDen.v := denominator.v DIV 5; 
001143 END; 

001144 selectPanel.SetZoomFactor(zoomNum, zoomDen); 
001145 selectPanel.Invalidate: 

001146 END; 

001147 
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uReduceToFit: 
{?} {can't do it now--how to express?} ; 


uSet HorzBreak: 
IF clickPanel.view.isPrintable THEN 
BEGIN 
clickPanel. view. printManager.SetBreak(h, clickPanel. view. clickLPt.v, FALSE) 
clickPanel. current View. ReDoBreaks 
clickPanel. I nvalidate: 
END; 


uSet Vert Break: 
IF clickPanel.view.isPrintable THEN 
BEGIN 
clickPanel. view. printManager.SetBreak(v, clickPanel. view. clickLPt.h, FALSE) 
clickPanel. current View. ReDoBreaks 
clickPanel.Invalidate; {later, do a more selective inval } 
END; 


uCl ear Breaks: 
IF clickPanel.view.isPrintable THEN 
BEGIN 
clickPanel. view. print Manager. Cl ear PageBreaks( FALSE) 
clickPanel. current View. ReDoBreaks 
clickPanel.Invalidate; {later, do a more selective inval } 
END; 


{$1 FC f DbgABC} 
{Debug Menu} 
uReportEvents: 

SELF. Toggl eFl ag( event Debug) ; 
uCount Heap: 

SELF. Toggl eFl ag( f Count Heap) ; 
uCheckI ndices: 

SELF. Toggl eFl ag( f Checkl ndices); 


uDumpGl obals: {dump process variables} 
process. DumpGl obals; 
uDumpPrel ude: {dump active document's prelude} 


document. DumpPrel ude 
uExperi menting: 
SELF. Toggl eFl ag( f Experi menting) ; 
uReptGarbage, uFreeGarbage: 
1F document <> clipboard THEN 
BEGIN 
MarkHeap(document.docHeap, ORD( document. dataSegment. preludePtr*. docDirectory)); 
SweepHeap(document.docHeap, cmdNumber = uReptGarbage); 
END; 
uMainScramble: 
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THz( mai nHeap) *.fScramble := NOT THz(mainHeap) *.f Scramble; 
uDocScrambl e: 
IF currentDocument <> NIL THEN 
THz(currentDocument.docHeap) *.fScramble := 
NOT THz( current Document. docHeap) *.f Scramble; 
{$ENDC} 


OTHERW SE 
BEGIN 
IF menuBar.GetCmdName(cmdNumber, @str) THEN 
process. ArgAlert(1, str) 
ELSE 
BEGIN 
{$I FC fDbgABC} 
ABCbreak('called new command, but no command in menu', cmdNumber); 
{$ENDC} 
process. ArgAlert(1, ‘Unknown Command' ); 
END; 


IF selection. kind = nothingKind THEN 
process. Stop( phNoSel } 
SE 


process. Stop( phUnkCmd) ; 
END; 
END; 


1F permCmd THEN 
BEGIN 
command := TCommand. CREATE( NIL, SELF.Heap, cmdNumber, NIL, FALSE, reveal None) 
WITH command DO 
BEGIN 
unHiliteBefore[doPhase] := FALSE; 
hiliteAfter[doPhase] := FALSE; 
END; 
NewStdCommand := command 
END; 


IF error > 0 THEN 
process. Stop( process. Phrase(error)); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sCommand} 
PROCEDURE {TWindow. }PerformCommand{(newCommand: TCommand) }; 
BEGIN 

{$I FC fTrace}BP(7); {$ENDC} 
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001244 1F newCommand <> NIL THEN {this is a command that changes the document} 
001245 BEGIN 

001246 {commit the previous command} 

001247 SELF. CommitLast; 

001248 

001249 {save the new command & get rid of the old one} 

001250 SELF. SaveCommand( newCommand); 

001251 

001252 {execute the new command} 

001253 SELF. Perf ormLast(doPhase) 

001254 END; 

001255 {$IFC fTrace}EP; {$ENDC} 

001256 END; 

001257 {$S SgABCres} 

001258 

001259 

001260 {$$ sCommand} 

001261 PROCEDURE {TWindow. }PerformLast{(cmdPhase: TCmdPhase)}; {+SW+} {LSR: Your version below, commented out} 
001262 VAR i mage: Tl mage 

001263 last Cmd: TCommand; 

001264 lastWindow: TW ndow 

001265 BEGIN 

001266 {$I1FC fTrace}BP(7); {$ENDC} 

001267 IF SELF <> current Window THEN 

001268 current Window. PerformLlast(cmdPhase) 

001269 ELSE 

001270 BEGIN 

001271 lastCmd := SELF.|astCmd; 

001272 image := lastCmd.i mage 

001273 IF image = NIL THEN 

001274 lastWindow := SELF 

001275 ELSE 

001276 last Window := image.view. panel. window; {+SW+} 

001277 

001278 {UnHighlight all selections before performing the command (unless command object says otherwise) } 
001279 IF lastCmd. unHiliteBefore[cmdPhase] THEN 

001280 current Window. select Window. Hi ghlight(hOnToOff); {+swt} 

001281 

001282 1F cmdPhase <> doPhase THEN 

001283 last Window. RestoreSel ection; {+s wt} 

001284 

001285 IF lastCmd. revelation <> reveal None THEN 

001286 last Window. Reveal Selection(lastCmd. revelation = reveal All 
001287 NOT | astCmd. unHiliteBefore[cmdPhase]); 
001288 

001289 last Window. selectPanel.selection. PerformCommand(|astCmd, cmdPhase); {+swt} 
001290 

001291 {Save selection in each panel; hilite if necessary} 
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001292 SELF. SaveSel ection; 

001293 

001294 1F NOT deferUpdate THEN 

001295 IF lastCmd. HiliteAfter[cmdPhase] THEN 
001296 BEGIN 

001297 last Window. Update( FALSE); {+s w+} 
001298 last Window. Hi ghl i ght(hOf f ToOn); {+s w+} 
001299 END 

001300 ELSE 

001301 last Window. Update( TRUE); {+swt} 

001302 END; 

001303 {$I1FC fTrace}EP; {$ENDC} 

001304 END; 

001305 

001306 

001307 (* PROCEDURE {TWindow. }PerformLast{(cmdPhase: TCmdPhase) }; 
001308 VAR |astCmd: TCommand; 

001309 

001310 PROCEDURE Performit; 

001311 BEGIN 

001312 {UnHighlight all selections before performing the command (unless command object says otherwise) } 
001313 IF lastCmd. unHiliteBefore[cmdPhase] THEN 
001314 SELF. Hi ghl i ght ( hOnToOff); 

001315 

001316 1F cmdPhase <> doPhase THEN 

001317 SELF. RestoreSel ection: 

001318 

001319 IF lastCmd. revelation <> reveal None THEN 
001320 SELF. Reveal Selection(lastCmd.revelation = reveal All, NOT lastCmd. unHiliteBefore[cmdPhase] ); 
001321 

001322 lastCmd. doing := cmdPhase <> undoPhase 

001323 lastCmd. Perf orm(cmdPhase) 

001324 

001325 {Save selection in each panel; hilite if necessary} 
001326 SELF. SaveSel ection: 

001327 

001328 IF lastCmd. HiliteAfter[cmdPhase] THEN 

001329 BEGIN 

001330 SELF. Update( FALSE); 

001331 SELF. Hi ghl i ght(hOffToOn); 

001332 END 

001333 ELSE 

001334 SELF. Update( TRUE); 

001335 END; 

001336 

001337 BEGIN 

001338 {$I1FC fTrace}BP(7); {$ENDC} 

001339 IF SELF <> current Window THEN 
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001340 
001341 
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current Window. PerformLast(cmdPhase) 
ELSE 

BEGIN 

lastCmd := SELF.] astCmd; 

Performit; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
*) 


{$S sStartup} 

PROCEDURE {TWindow. }PickStdCursor 

BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
Set StdCursor(arrowCursor); 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$1FC LibraryVersion > 20} 
{$S SgABCcl d} 


PROCEDURE {TWindow. }PrefixToName(VAR error, offset: INTEGER; VAR prefix, name: TFilePath); 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
PrefixToName(error, offset, WindowPtr(SELF.wmgrlD), Pathname(prefix), Pathname( name) ); 
{$1FC fTrace}EP; {$ENDC} 
END: 
{$$ SgABCres} 
{$ENDC} 
{$S SgABCpri } 
PROCEDURE {TWndow. }Print{(panel: TPanel; nixPgRange: BOOLEAN; nixWhol eDialog: BOOLEAN) }; 
VAR prPrf Alias: TPrPrf Alias 
indeedPrint: BOOLEAN 
isNewStyle: BOOLEAN 
document: TDocManager 
{$1FC libraryVersion <= 20} { PEPSI } 
error: INTEGER; 
prins: TPrins; 
{$ELSEC} {SPRING } 
prins: TPrRec; 
pr Mode: PrMenuSuppress 
{$ENDC} 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF currentDocument <> NIL THEN 
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001388 document := current Document 

001389 ELSE 

001390 document := boundDocument; 

001391 

001392 IF document = clipboard THEN 

001393 prPrfAlias.reserve := clipPrintPref 

001394 ELSE 

001395 prPrfAlias. reserve := document. dataSegment. preludePtr%. Print Pref; 
001396 

001397 PushFocus 

001398 {$IFC libraryVersion <= 20} { PEPSI } 

001399 indeedPrint := FPrinsDig(error, prPrfAlias.prPrf, prPrfAlias. prins, isNewStyle); 
001400 {$ELSEC} {SPRING} 

001401 1F nixWhol eDialog THEN 

001402 prMode := ePrDialogSuppress 

001403 ELSE 

001404 1F nixPgRange THEN 

001405 prMode := ePgRangeSuppress 

001406 ELSE 

001407 prMode := ePrNormal 

001408 

001409 indeedPrint := FPrinsDig(prPrfAlias.prPrf, isNewStyle, prMode) 
001410 {$ENDC} 

001411 PopFocus; 

001412 

001413 {$l1FC libraryVersion <= 20} { PEPSI } 

001414 IF error > 0 THEN 

001415 process. Stop( phUnknown) {PrMgr passed on an OS error} 
001416 ELSE 

001417 {$ENDC} 

001418 BEGIN 

001419 IF isNewStyle THEN {style changed during print-instance dial og} 
001420 SELF. Accept NewPrinterlnfo(document, prPrfAlias. reserve) 
001421 

001422 1F indeedPrint THEN 

001423 BEGIN 

001424 amPrinting := TRUE; 

001425 PushFocus; 

001426 panel. PrintView(prPrf Alias. reserve) 

001427 amPrinting := FALSE; 

001428 PopFocus; 

001429 

001430 SELF.Update(TRUE); {clear out white area from RECORDING box} 
001431 {$IFC libraryVersion <= 20} { PEPSI } 

001432 PrBgdDi g(error, FALSE); {put up background dialog} 


001433 {$ENDC} {NB: For Spring, user-interface says we go back to the app, not to the background dialog} 
001434 END; 
001435 END; 
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001480 
001481 
001482 
001483 


(* 


{$8 


{$8 
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{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCcl d} 
PROCEDURE {TWindow. }Put UpDi al ogBox{(dial ogBox: TDi al ogBox) }; 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 

SELF. Commi tLast; 

SELF. dial ogBox := dial ogBox; 

1F dialogBox.selectWndow <> NIL THEN 


SELF.select Window := dialogBox.selectWindow; *) {+SW+} 


di al ogBox. Appear; 

{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


sStartup} 


PROCEDURE {TWindow. }Refresh{(rActions: TActions; highTransit: THighTransit) }; 


PROCEDURE RefreshPanel (obj: TObject); 
VAR panel: TPanel 
BEGIN 
panel := TPanel (obj); 
IF RectisVisible(panel.outerRect) THEN 
panel. Refresh(rActions, highTransit); 
END; 


BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
[F SELF = clipboard. window THEN 
highTransit := hNone 
{$1 FC fDbgABC} 
| F 


(rBackground IN rActions) AND (highTransit > hOffToOn) THEN 


ABCBreak('Refresh: rBackground requested, but highTransit does not start from Off', 0); 


{$ENDC} 
1F rFrame IN rActions THEN 
SELF. Frame; 


SELF. panels. Each( RefreshPanel ) 
{$IFC fTrace}EP; {$ENDC} 

END; 

SgABCres} 


{$S sStartup} 
PROCEDURE {TWindow. }Resize{( moving: BOOLEAN) }; 
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001484 {Make the Tool Kit data structures agree with the window manager's idea of the window size 
001485 also, ensure that bottomright corner of windowis on the screen} 
001486 VAR ol dOuterRect: Rect; 

001487 my Graf Port: Graf Ptr; 

001488 newScreenRect: Rect; 

001489 proposedSi ze: Point; 

001490 mi nExtent: Point; 

001491 newOuterRect: Rect; 

001492 currentl yVisi ble: BOOLEAN 

001493 BEGIN 

001494 {$IFC fTrace}BP(7); {$ENDC} 

001495 PushFocus 

001496 SELF. Focus 

001497 

001498 currentlyVisible := SELF. IsVisible; 

001499 my Graf Port: = POI NTER( SELF. wmgr! D) 

001500 

001501 1F currentlyVisible THEN 

001502 BEGIN 

001503 { Find out where the windowis on the screen } 

001504 newScreenRect := myGrafPort*. portRect; 

001505 

001506 proposedSize := Point(FDiagRect(newScreenRect) ); 

001507 

001508 1F NOT SELF. believeWmgr THEN 

001509 WITH SELF DO 

001510 BEGIN 

001511 maxl nnerSize := proposedSize 

001512 believeWmgr := TRUE; 

001513 END; 

001514 

001515 1F moving THEN { Constrain it to the maximum explicitly set by the user } 
001516 BEGIN 

001517 Local ToGl obal (newScreenRect.topLeft); 

001518 { Propose the window botRight be at the screen botRight } 

001519 proposedSize := Point(FPtMinPt( Poi nt(FPtMi nusPt(screenBits. bounds. botRi ght, 
001520 newScreenRect.topLeft)), 
001521 SELF. max! nner Size) ); 

001522 END; 

001523 END 

001524 ELSE 

001525 proposedSize := Point(FDiagRect(SELF.innerRect)); 

001526 

001527 { But be sure it is at least the minimum size } 

001528 SELF. Get Mi nExtent(minExtent, TRUE) 

001529 proposedSize := Point(FPtMaxPt( proposedSize, minExtent)) 

001530 

001531 1F NOT moving THEN 
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001532 
001533 
001534 
001535 
001536 
001537 
001538 
001539 
001540 
001541 
001542 
001543 
001544 
001545 
001546 
001547 
001548 
001549 
001550 
001551 
001552 
001553 
001554 
001555 
001556 
001557 
001558 
001559 
001560 
001561 
001562 
001563 
001564 
001565 
001566 
001567 
001568 
001569 
001570 
001571 
001572 
001573 
001574 
001575 
001576 
001577 
001578 
001579 
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SELF. maxl nnerSize := proposedSize 


oldQuterRect := SELF. outerRect; 
SetRect(newScreenRect, 0, 0, proposedSize.h, proposedSize.v) 


IF currentlyVisible THEN 
{ finally set the wmgr window ("folder") size. } 
FolderSize(myGrafPort, proposedSize.h, proposedSize.v, FALSE); 


{ Reset our idea of window's size } 
SELF. SetI nnerRect(newScreenRect); 


ClipRect(SELF.innerRect); 

focusRgn := thePort*. visRgn; 

newOuterRect := SELF. outerRect; 

1F NOT Equal Pt(oldOuterRect. botRight, newOuterRect. botRight) THEN 
SELF. panel Tree, Resi zeOutsi de( newOuter Rect); 


PopFocus; 

{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$8 SgABCcl d} 
PROCEDURE {TWindow. }ResizeTo{(newSize: Point) }; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
1F NOT Equal Pt( Point(FDiagRect(SELF.innerRect)), newSize) THEN 
BEGIN 
FolderSize(POINTER(SELF.wmgriD), newSize.h, newSize.v, FALSE) 
SELF. Resize( FALSE); 


END; 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S sRes} 
PROCEDURE {TWindow. }RestoreSel ection; 
PROCEDURE RestoreSel (obj: TObj ect); 
BEGIN 
TPanel(obj).undoSelection. Restore; {$} 
END; 


BEGIN 
{$1FC fTrace}BP(7); {$ENDC} 
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001580 SELF.selectPanel := SELF. undoSel Panel 

001581 SELF.clickPanel := SELF. undoClickPanel 

001582 SELF.select Window := SELF. undoSel Window; {+SW+} 
001583 SELF. panels. Each( RestoreSel ); 

001584 IF SELF.dialogBox <> NIL THEN 

001585 SELF. dial ogBox. RestoreSel ection; 

001586 {$IFC fTrace}EP; {$ENDC} 

001587 END; 

001588 

001589 

001590 

001591 {$$ sCommand} 

001592 PROCEDURE {TWindow. }Reveal Selection(asMuchAsPossible, doHilite: BOOLEAN) 
001593 PROCEDURE Revi Sel (obj: TObj ect); 

001594 BEGIN 

001595 TPanel (obj).selection. Reveal (asMuchAsPossi ble); 
001596 END; 

001597 

001598 BEGIN 

001599 {$I1FC fTrace}BP(7); {$ENDC} 

001600 SELF. Update(doHi lite) 

001601 SELF. panels. Each( Revi Sel ) 

001602 SELF. Update( doHi lite) 

001603 {$I1FC fTrace}EP; {$ENDC} 

001604 END; 

001605 

001606 

001607 {$$ sCommand} 

001608 PROCEDURE {TWindow. }SaveCommand{( command: TCommand) }; 
001609 

001610 PROCEDURE SaveUndoSelection(obj: TObject); 

001611 VAR panel: TPanel 

001612 sel: TSel ection: 

001613 BEGIN 

001614 panel := TPanel (obj); 

001615 sel := panel. undoSel ection. FreedAndRepl acedBy(TSel ection(panel.selection. Clone( SELF. Heap) )); 
001616 END; 

001617 

001618 BEGIN {Called by PerformCommand between NewCommand & PerformLast to establish an undo- point} 
001619 {$I1FC fTrace}BP(7); {$ENDC} 

001620 IF SELF <> current Window THEN 

001621 current Window. SaveCommand(command) {probably this is a dialog box} 
001622 ELSE 

001623 IF SELF.lastCmd <> NIL THEN 

001624 SELF. 1 astCmd. Become( command) 

001625 ELSE 

001626 SELF.lastCmd := command 

001627 
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001628 
001629 
001630 
001631 
001632 
001633 
001634 
001635 
001636 
001637 
001638 
001639 
001640 
001641 
001642 
001643 
001644 
001645 
001646 
001647 
001648 
001649 
001650 
001651 
001652 
001653 
001654 
001655 
001656 
001657 
001658 
001659 
001660 
001661 
001662 
001663 
001664 
001665 
001666 
001667 
001668 
001669 
001670 
001671 
001672 
001673 
001674 
001675 
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SELF. panels. Each( SaveUndoSel ection); 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ sCommand} 

PROCEDURE {TWindow. }SaveSel ecti on; 
PROCEDURE SaveSel(obj: TObj ect); 
BEGIN 

TPanel (obj).selection, Save 
END; 


BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
SELF. panels. Each( SaveSel } 
SELF. undoSel Panel := SELF.selectPanel 
SELF. undoClickPanel := SELF.clickPanel; 
SELF. undoSel Window := SELF.selectWindow; {+SW+} 
1F SELF.dialogBox <> NIL THEN 
SELF. dial ogBox. SaveSel ecti on; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ sCommand} 
PROCEDURE {TWindow. }SetupMenus; 
VAR anS255: $255; 
undoTempl: TCmdNumber; 
mapHandle: TMapHandle; 
selection: TSelection; 


i: INTEGER; 
wimg r C md: TWmgr C md; 
checklt: BOOLEAN 


mai nWindow: TWindow; 
BEGIN {NOTE: wmgrMenus[menulndex] can not be assigned to a local variable because it is passed as a VAR} 
{$IFC fTrace}BP(5); {$ENDC} 
mainWindow := current Window 


{First, change the text of the Set Aside and Undo items. } 

mai nWindow. GetTitle(an$255); {don't use SELF because we might be a dialog box} 
an$255 := CONCAT('"', an$255, ‘'"'): 

menuBar, BuildCmdName(uSetAside, utSetAside, @an$255); 

menuBar. BuildCmdName(uSetClipAside, utSetAside, @an$255); 


1F mainWindow.|astCmd = NIL THEN {the mainWindow always has the last command} 


menuBar. BuildCmdName(uUndoLast, utUndoLast, NIL) 
ELSE 
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001676 BEGIN 

001677 1F mai nWindow.|astCmd. doing THEN 

001678 undoTempl := utUndoLast 

001679 ELSE 

001680 undoTempl := utRedoLast; 

001681 

001682 1F menuBar. Get CmdName( mainWindow.!astCmd.cmdNumber, @anS255) THEN 
001683 BEGIN 

001684 an$255 := CONCAT('"', an$255, '"'); 

001685 menuBar. BuildCmdName(uUndoLast, undoTempl, @an$255) 
001686 END 

001687 ELSE 

001688 menuBar. BuildCmdName(uUndoLast, undoTempl, NIL); 
001689 END; 

001690 

001691 {Then enable and check the appropriate items} 

001692 mapHandle := TMapHandl e( menuBar. mappi ng) 

001693 selection := SELF.selectPanel.sel ection; 

001694 

001695 FOR i := 1 TO menuBar. numCommands DO 

001696 BEGIN 

001697 wmgrCmd := mapHandle**.table[i]; 

001698 WITH wmgrCmd DO 

001699 IF menuBar.isLoaded[ menul ndex] THEN 

001700 BEGIN 

001701 checklt := FALSE: 

001702 

001703 ( RRR ERK KK E 

001704 IF selection. CanDoCommand(cmdNumber, checklt) THEN 
001705 Enabl eltem( wmgrMenus[ menul ndex], iteml ndex) 
001706 ELSE 

001707 Disabl el tem( wmgrMenus[ menul ndex], iteml ndex) 
001709 

001710 {The following line is an optimization for the preceding} 
001711 wmgr Menus[ menul ndex].enableFlags[itemlndex] := 
001712 selection. CanDoCommand(cmdNumber, checkit); 
001713 Checkl tem( wmgrMenus[ menulndex], itemlndex, checkit); 
001714 END; 

001715 END; 

001716 {$I1FC fTrace}EP; {$ENDC} 

001717 END; 

001718 

001719 

001720 {$8 SgABCi ni } 

001721 PROCEDURE {TWindow. }Set Wmgrid{(itsWmgrid: TWi ndowl D)}; 

001722 VAR panel Scanner: TListScanner 

001723 panel: TPanel 
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001724 paneScanner: TListScanner 

001725 pane: TPane; 

001726 BEGIN 

001727 {$I1FC fTrace}BP(7); {$ENDC} 

001728 SELF. wmgrid := itsWmgrld; 

001729 panel Scanner := SELF. panels. Scanner 

001730 WHILE panel Scanner. Scan(panel) DO 

001731 BEGIN 

001732 paneScanner := panel. panes. Scanner; 
001733 WHILE paneScanner. Scan(pane) DO 

001734 pane. port := POINTER(itsWmgrl d) 
001735 D; 

001736 {$1FC fTrace}EP; {$ENDC} 

001737 END; 

001738 {$S SgABCres} 

001739 

001740 

001741 {$S SgABCcl d} 

001742 PROCEDURE {TWndow. }StashPicture{(highTransit: THighTransit) }; 
001743 BEGIN 

001744 {$IFC fTrace}BP(7); {$ENDC} 

001745 RectRgn(altVisRgn, SELF. outerRect); 

001746 useAltVisRgn := TRUE; {Make TPad. Focus use altVisRgn instead of visRgn} 
001747 

001748 PushFocus 

001749 SELF. Focus 

001750 

001751 WMOpenPicture( POI NTER( SELF. wmgrl D)); 
001752 SELF. Refresh([rErase, rFrame, rBackground, rDraw], highTransit); {recorded & not displayed} 
001753 WMCI osePicture 

001754 

001755 useAltVisRgn := FALSE; 

001756 

001757 PopFocus; 

001758 {$IFC fTrace}EP; {$ENDC} 

001759 END; 

001760 {$S SgABCres} 

001761 

001762 

001763 {$S SgABCcl d} 

001764 PROCEDURE {TWndow. }TakeDownDi al ogBox; {+swt} 
001765 VAR dialogBox: TDi al ogBox; 

001766 BEGIN 

001767 {$I1FC fTrace}BP(7); {$ENDC} 

001768 {Don't CommitLast here, because the Dialog Box may have created a command that can be undone | ater} 
001769 dialogBox := SELF. dial ogBox; 

001770 1F dialogBox <> NIL THEN 

001771 BEGIN 
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001772 
001773 
001774 
001775 
001776 
001777 
001778 
001779 
001780 
001781 
001782 
001783 
001784 
001785 
001786 
001787 
001788 
001789 
001790 
001791 
001792 
001793 
001794 
001795 
001796 
001797 
001798 
001799 
001800 
001801 
001802 
001803 
001804 
001805 
001806 
001807 
001808 
001809 
001810 
001811 
001812 
001813 
001814 
001815 
001816 
001817 
001818 
001819 
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[F SELF.lastCmd <> NIL THEN 
[F SELF.lastCmd.image <> NIL THEN 
1F SELF.lastCmd.i mage. view. panel. window = dialogBox THEN 
SELF.CommitLast; {+swt} 


di al ogBox. Disappear 
[F dialogBox.freeOnDismissal THEN 


SELF. objectToFree := dialogBox; {+SW+} {will be freed at end of event | oop} 


SELF. dialogBox := NIL; 
SELF.select Window := SELF: 
END 
ELSE 
ABCBreak('TakeDownDi alogBox, but none up', 0); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$1 FC fDbgABC} 
{$S SgABCdbg} 
PROCEDURE {TWindow. }ToggleFlag{(VAR flag: BOOLEAN) }; 
BEGIN 
{$I1FC fTrace}BP(1); {$ENDC} 
flag := NOT flag; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 
{$ENDC} 


{$S SgABCcl d} 
PROCEDURE {TWindow. }UndoLast; 


VAR | ast Cmd: TCommand; 
str: $255; 
cmdPhase: TCmdPhase 

BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 
1F SELF <> current Window THEN 
current Window. UndoLast 
ELSE 
BEGIN 
lastCmd := SELF.]astCmd; 
IF lastCmd = NIL THEN 
process. Stop( phNoCommand) 
ELSE 
1F NOT |lastCmd. undoable THEN 
BEGIN 
1F NOT menuBar. GetCmdName(lastCmd.cmdNumber, @str) THEN 
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001820 BEGIN 

001821 {$1 FC fDbgABC} ABCbreak('TCommand.cmdNumber not in menu', |astCmd.cmdNumber); {$ENDC} 
001822 str := 'Last Command' 

001823 END; 

001824 process. ArgAlert(1, str); 

001825 process. Stop( phCant Undo); 

001826 END 

001827 ELSE 

001828 IF lastCmd. doing THEN 

001829 SELF. Perf ormLast(undoPhase) 

001830 ELSE 

001831 SELF. PerformLast(redoPhase) 

001832 END; 

001833 {$1FC fTrace}EP; {$ENDC} 

001834 END; 

001835 {$S SgABCres} 

001836 

001837 

001838 {$S sStartup} 

001839 PROCEDURE {TWindow. }Update{(doHilite: BOOLEAN) }; 
001840 VAR pWi ndow: Wi ndowPtr; 

001841 updateRgn: RgnHandl e; 

001842 highTransit: THi ghTransit 

001843 BEGIN 

001844 {$I1FC fTrace}BP(7); {$ENDC} 

001845 PushFocus 

001846 SELF. Focus 

001847 pWindow : = POINTER( SELF. wmgrI D); 

001848 Begi nUpdate( pWi ndow); 

001849 updateRgn := pWindow*. visRgn; 

001850 |F NOT EmptyRgn(updateRgn) THEN 

001851 BEGIN 

001852 IF doHilite THEN 

001853 highTransit := highLevel[SELF.isActive] 
001854 ELSE 

001855 highTransit := hNone; 

001856 Fill Rgn(updateRgn, white); 

001857 SELF. Refresh([rFrame, rBackground, rDraw], highTransit); 
001858 END; 

001859 EndUpdate( pWi ndow); 

001860 PopFocus; 

001861 {$I1FC fTrace}EP; {$ENDC} 

001862 END; 

001863 {$8 SgABCres} 

001864 

001865 

001866 {$S sStartup} 

001867 FUNCTION {TWindow. }WantMenu{(menul D: INTEGER; inClipboard: BOOLEAN): BOOLEAN}; 
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001868 BEGI N 

001869 {$1FC fTrace}BP( 3); {$ENDC} 

001870 IF inClipboard THEN 

001871 WantMenu := menulD = mnuCli pFil ePri nt 

001872 ELSE 

001873 WantMenu := (menulD < mBuzzword) 

001874 {$I1FC fTrace}EP; {$ENDC} 

001875 END; 

001876 {$S SgABCres} 

001877 

001878 

001879 {$S SgABCi ni } 

001880 END; 

001881 {$8 SgABCres} 

001882 

001883 

001884 METHODS OF TDi al ogBox; 

001885 

001886 

001887 {$S SgABCcl d} 

001888 FUNCTION {TDialogBox. }CREATE{(object: TObject; heap: THeap; itsResizability: BOOLEAN; itsHeight: INTEGER 
001889 itsKeyResponse, itsMenuResponse 
001890 itsDownl nMai nWi ndowResponse: TDiResponse): TDial ogBox}; 
001891 VAR diBxRect: Rect; 

001892 BEGIN 

001893 {$I1FC fTrace}BP(7); {$ENDC} 

001894 IF object = NIL THEN 

001895 object := NewObject(heap, THISCLASS) 

001896 SELF := TDi al ogBox(TWindow. CREATE(object, heap, ORD(dialogFolder), itsResizability)); 
001897 

001898 WITH SELF DO 

001899 BEGIN 

001900 keyResponse := itsKeyResponse 

001901 menuResponse := itsMenuResponse 

001902 downl nMai nWi ndowResponse := itsDownI nMai nWi ndowResponse 
001903 freeOnDismissal := FALSE; {+SW+} 

001904 END; 

001905 SELF.GetPrinterMetrics; {mostly just so that these won't be total garbage in debug output} 
001906 SetRect(diBxRect, 0, 0, screenBits. bounds. right, itsHeight); 
001907 SELF. Setl nner Rect (diBxRect); 

001908 {$I1FC fTrace}EP; {$ENDC} 

001909 END; 

001910 {$S SgABCres} 

001911 

001912 

001913 {$1 FC fDebugMet hods} 

001914 {$S SgABCdbg} 

001915 PROCEDURE {TDi al ogBox. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
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001916 BEGIN 

001917 TWindow. Fields(Field); 

001918 Field('keyResponse: Byte'); 

001919 Field('menuResponse: Byte') 

001920 Field('downl nMai nWindowResponse: Byte’) 

001921 Field('freeOnDismissal: BOOLEAN'); {+SW+} 

001922 Field(''); 

001923 END; 

001924 {$S SgABCres} 

001925 {$ENDC} 

001926 

001927 

001928 {$S SgABCcl d} 

001929 PROCEDURE {TDi al ogBox. }Appear 

001930 BEGIN 

001931 {$I1FC fTrace}BP(7); {$ENDC} 

001932 Di al ogHei ght(LengthRect(SELF.innerRect, v), TRUE); 
001933 SELF. outerRect. bottom := SELF.outerRect.top; {force Resize to recalculate everything} 
001934 SELF. Resize( FALSE); 

001935 {$SIFC fTrace}EP; {$ENDC} 

001936 END; 

001937 

001938 

001939 {$S SgABCcl d} 

001940 PROCEDURE {TDi al ogBox. }BeDismissed 

001941 BEGIN 

001942 {$I1FC fTrace}BP(7); {$ENDC} 

001943 current Window. TakeDownDi al ogBox; 

001944 {$I1FC fTrace}EP; {$ENDC} 

001945 END; 

001946 

001947 

001948 {$8 SgABCcl d} 

001949 PROCEDURE {TDi al ogBox. }Disappear 

001950 BEGIN 

001951 {$IFC fTrace}BP(7); {$ENDC} 

001952 Di al ogHei ght(0, FALSE) 

001953 SELF. believeWmgr := FALSE; {the window's innerRect is known to NOT match the size of the dialog box} 
001954 {$I1FC fTrace}EP; {$ENDC} 

001955 END; 

001956 

001957 

001958 {$S SgABCcl d} 

001959 PROCEDURE {TDi al ogBox. }Get Mi nExtent{( VAR minExtent: Point; windowlsResizinglt: BOOLEAN) }; 
001960 BEGIN 

001961 {$1FC fTrace}BP(9); {$ENDC} 

001962 SUPERSELF. Get Mi nExtent(minExtent, windowlsResi zi nglt) 
001963 mi nExtent.h := screenBits. bounds. ri ght 
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001964 
001965 
001966 
001967 
001968 
001969 
001970 
001971 
001972 
001973 
001974 
001975 
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001977 
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001984 
001985 
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001987 
001988 
001989 
001990 
001991 
001992 
001993 
001994 
001995 
001996 
001997 
001998 
001999 
002000 
002001 
002002 
002003 
002004 
002005 
002006 
002007 
002008 
002009 
002010 
002011 
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{$I1FC fTrace}EP; {$ENDC} 


END; 


{$S SgABCres} 


{$$ SgABCcl d} 


FUNCTI 


VAR info: 


BEGIN 


ON {TDialogBox. }IlsVisible{: BOOLEAN}; 


Wi ndowl nfo; 


{$1 FC fTrace}BP(3); {$ENDC} 
1F SUPERSELF.IsVisible THEN 


IsVisible := 


ELSE 


IsVisible := FALSE; 


{$I1FC fTrace}EP; {$ENDC} 


END; 


{$S SgABCres} 


{$$ SgABCi 
END; 


ni } 


{$5 SgABCres} 


{SUBROUTINES OF TMenuBar } 


{$$ sRes} 


PROCEDURE 


VAR i: 


| owl DX: 


hi 


mapHandl e: 
f Found: 


BEGIN 


fFound := 
mapHandl e 


InAll MenusDo{(ifflLoaded: BOOLEAN 
PROCEDURE doProc(VAR menu 

INTEGER; 

INTEGER; 

INTEGER; 

TMapHandl e; 

BOOLEAN; 


ghl DX: 


FALSE; 
:= TMapHandl e( menuBar. mappi ng) 


lowl DX := 1; 


hi ghI DX : = 


WHI LE 


menuBar. numCommands; 


NOT fFound AND (lowldx <= highldx) DO 


BEGIN 


:= (low! DX+highIl DX) DIV 2; 


current Window. dialogBox = SELF 


theCommand: 
Menul nfo; 


TCmdNumber; 


iteml ndex: 


INTEGER) ) }; 


{$R-} WITH mapHandle**.table[i] DO {$IFC fRngABC}{$R+}{$ENDC} { OK to do this because once 
we call doProc, we don't refer to this record any more } 


1F theCommand = cmdNumber THEN 


BEGIN 
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002013 
002014 
002015 
002016 
002017 
002018 
002019 
002020 
002021 
002022 
002023 
002024 
002025 
002026 
002027 
002028 
002029 
002030 
002031 
002032 
002033 
002034 
002035 
002036 
002037 
002038 
002039 
002040 
002041 
002042 
002043 
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002045 
002046 
002047 
002048 
002049 
002050 
002051 
002052 
002053 
002054 
002055 
002056 
002057 
002058 
002059 
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f Found := TRUE; 
1F menuBar.isLoaded[ menulndex] = iffLoaded THEN 
doProc( wmgr Menus[ menul ndex], iteml ndex) 


END 

ELSE 

1F theCommand > cmdNumber THEN 
lowl DX := itl 

ELSE 
hi ghI DX := i-1; 


END; 
END; 


{$$ sCommand} 
FUNCTION CmdFromWmgr(menuld, item ndex: INTEGER): TCmdNumber 
VAR wmgr Cmd: TWmgr C md; 
cmdNumber: TCmdNumber 
i: INTEGER; 
mapHandle: TMapHandle; 
BEGIN {does not need to be very fast} 
{$IFC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
IF itemlndex < 0 THEN 


CmdFromWmgr := -itemlndex {this is how we will implement graphical menus} 
ELSE 
BEGIN 
mapHandle := TMapHandl e( menuBar. mapping); 
FOR i := 1 TO menuBar. numCommands DO 
BEGIN 
{$R- } 


wmgrCmd := mapHandle**.table[i]; 
{$1 FC fRngABC}{$R+}{$ENDC} 
1F wmgrCmd.itemlndex = itemlndex THEN 
IF menuBar.isLoaded[ wmgrCmd. menul ndex] THEN 
1F wmgrMenus[ wmgrCmd. menulndex].menuld = menuld THEN 


BEGIN 
CmdFromWmgr := wmgrCmd. cmdNumber; 
EXI T( CmdFromWmgr) ; 
END; 
END; 
CmdFromWmgr := 0; 
END; 
END; 
{$$ sRes} 


FUNCTION FindMenu( menul D: INTEGER): INTEGER 
{ given a menulD (the number in the phrase file) return the menulndex into 
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our array of menulnfo records } 


VAR menulndex: INTEGER: 


BEGIN 


{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$I FC fMaxTrace}EP: {$ENDC} 


FOR menulndex := 1 TO menuBar.numMenus DO 


1F wmgrMenus[ menul ndex].menulD = menulD THEN 
BEGIN 
FindMenu := menul ndex: 
EX! T( FindMenu); 
END; 


FindMenu := 0: 


END; 


METHODS OF TMenuBar; 


{$8 SgABCi ni } 
FUNCTION {TMenuBar. }CREATE{(object: TObject; heap: THeap; itsScanner: TFileScanner): TMenuBar}; 


VAR menu: Menul nfo; 
numMenus: INTEGER; 
i: | NTEGER; 
numBytes: INTEGER; 
mapping: TArray; 
numCommands: INTEGER; 
BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 

object := NewObject(heap, THISCLASS); 
SELF := TMenuBar( object); 


menu. drawProc := @drawTxt Menu; 
menu. chooseProc := @chooseTxt! tem; 
numMenus := itsScanner. ReadNumber( 2); 
SELF. numMenus := numMenus; 
FOR i := 1 TO numMenus DO 
BEGIN 
menu. menuld := itsScanner. ReadNumber( 2); 
itsScanner. XferSequential(xRead, @menu.enableFlags, 4); 
numBytes := itsScanner. ReadNumber (2); 
menu. menuData := POI NTER( ORD( HAI! ocate(POINTER(ORD( heap)), numBytes))); 
itsScanner. XferSequential(xRead, @menu. menuData**, numBytes); 
Cal cMenuSize( menu); 
wmgrMenus[i] := menu; 
SELF.isLoaded[i] := FALSE: 
END; 
mapping := POINTER(ORD(itsScanner. ReadArray(heap, SI ZEOF( TWmgrCmd)))); 
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SELF. mapping := mapping 
numCommands := mapping. Size 
SELF. numCommands := numCommands 
InitErrorAbort(itsScanner.error); 
{$SIFC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$1 FC fDebugMet hods} 

{$S SgABCdbg} 

PROCEDURE {TMenuBar. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 


Field('isLoaded: ARRAY [1..31] OF BOOLEAN'); (* MaxMenus = 31 *) 


Field(' mapping: TArray'); 
Field('numMenus: | NTEGER'); 
Field('numCommands: I NTEGER'); 

END; 

{$S SgABCres} 

{$ENDC} 


{$$ sRes} 
PROCEDURE {TMenuBar. }BuildCmdName{(destCmd, templateCmd: TCmdNumber 
VAR templ: $255; 
xStart: INTEGER 
XEnd: INTEGER; 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
1F SELF.GetCmdName(templ ateCmd, @templ) THEN 
BEGIN 
xStart := POS('*', templ) 
1F xStart > 0 THEN 
BEGIN 
DELETE(templ, xStart, 1); 


xEnd := POS('*', templ); 
1F xEnd > 0 THEN 
DELETE(templ, xEnd, 1) 
ELSE 
xEnd := LENGTH(templ) + 1; 


IF param <> NIL THEN 
BEGIN 
DELETE(templ, xStart, xEnd-xStart); 
INSERT( param’, templ, xStart); 
END; 
END; 


param: TPString)}; 
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SELF. PutCmdName(destCmd, @templ ) 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TMenuBar. }Check{(cmdNumber: TCmdNumber; checked: BOOLEAN) }; 
Label 1; 
PROCEDURE DoCheck(VAR menu: Menul nfo; iteml ndex: | NTEGER) 
BEGIN 
Checkl tem( menu, itemlndex, checked); 
Goto 1; 
END; 
BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
InAl | MenusDo( TRUE, cmdNumber, DoCheck); 
1: {$1FC fTrace}EP;: {$ENDC} 
END; 


{$$ sCommand} 
FUNCTION {TMenuBar. }CmdKey{(ch: CHAR): TCmdNumber }; 
VAR menuld, itemlndex: INTEGER 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
MenuKey(ch, menuld, iteml ndex); 
if menuld <> 0 THEN 
Hi LiteMenu( menuld); 
CmdKey := CmdFromWmgr(menuld, iteml ndex); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 

PROCEDURE {TMenuBar. }Delete{(menul D: | NTEGER) }; 
VAR menulndex: INTEGER 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
DeleteMenu( menul d); 
menul ndex := FindMenu( menul D); 
1F menulndex > 0 THEN 

SELF. isLoaded[ menul ndex] := FALSE; 

{$I1FC fTrace}EP; {$ENDC} 

END; 
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{$$ sCommand} 

FUNCTION {TMenuBar. }DownAt{(mousePt: Point): TCmdNumber}; 
VAR menuld, itemlndex: INTEGER 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
process. ChangeCursor(arrowCursor); 
MenuSelect(mousePt, menuld, iteml ndex); 
if menuld <> 0 THEN 

Hi LiteMenu( menuld); 

DownAt := CmdFromWmgr(menuld, iteml ndex) 
{$IFC fTrace}EP; {$ENDC} 

END; 


{$S sStartup} 
PROCEDURE {TMenuBar. }Draw 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
DrawMenuBar 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TMenuBar. }Enable{(cmdNumber: TCmdNumber; canBeChosen: BOOLEAN) }; 
BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
1F canBeChosen THEN 
I nAll MenusDo( TRUE, cmdNumber, Enableltem) 
ELSE 
InAll MenusDo( TRUE, cmdNumber, Disableltem); 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TMenuBar. }EndCmd: 
BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
Hi LiteMenu(0); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
FUNCTION {TMenuBar. }GetCmdName{(cmdNumber: TCmdNumber; pName: TPString): BOOLEAN}; 
Label 1; 
PROCEDURE DoGet(VAR menu: Menulnfo; itemlndex: INTEGER); 
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VAR kludge: Str255; 


BEGIN 
1F pName <> NIL THEN 
BEGIN 
Getl tem( menu, itemlndex, @kludge); 
XferLeft(@kludge, POINTER(ORD( pName)), LENGTH( kl udge) +1); 
END; 
Goto 1; 
END; 
BEGIN 


{$I1FC fTrace}BP(6); {$ENDC} 

GetCmdName := TRUE; 

InAll MenusDo( TRUE, cmdNumber, DoGet); 

InAll MenusDo( FALSE, cmdNumber, DoGet); 

GetCmdName := FALSE; 

IF pName <> NIL THEN 

pName* := ''; 

1: {$IFC fTrace}EP; {$ENDC} 
END; 


{$5 sRes} 
PROCEDURE {TMenuBar. }HighlightMenu(withCmd: TCmdNumber) ; 
LABEL 1; 


PROCEDURE DoHighlight(VAR menu: Menulnfo; itemlndex: INTEGER); 
BEGIN 
Hi LiteMenu( menu. menul D); 
Goto 1; 
END; 
BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
InAll MenusDo( TRUE, withCmd, DoHi ghli ght); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TMenuBar. }Il nsert{(menulD, beforeld: INTEGER) }; 
VAR menulndex: INTEGER 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
menul ndex := FindMenu( menul D); 
1F menulndex > 0 THEN 
BEGIN 
Insert Menu( wmgrMenus[ menulndex], beforeld) 
SELF.isLoaded[ menul ndex] := TRUE; 
END: 


Apple Lisa ToolKit 3.0 Source Code Listing -- 267 of 


1012 


002300 
002301 
002302 
002303 
002304 
002305 
002306 
002307 
002308 
002309 
002310 
002311 
002312 
002313 
002314 
002315 
002316 
002317 
002318 
002319 
002320 
002321 
002322 
002323 
002324 
002325 
002326 
002327 
002328 
002329 
002330 
002331 
002332 
002333 
002334 
002335 
002336 
002337 
002338 
002339 
002340 
002341 
002342 
002343 
002344 
002345 
002346 
002347 


Apple Lisa Computer Technical Information 


{$1FC fTrace}EP; {$ENDC} 
END; 


{$S SgABCcl d} 
FUNCTION {TMenuBar. }MenuWithID(menul D: INTEGER): Ptr; 
VAR menulndex: INTEGER 


BEGIN 
{$1FC fTrace}BP( 7); {$ENDC} 
menul ndex := FindMenu( menul D); 


1F menulndex > 0 THEN 
MenuWithild := @wmgrMenus[ menul ndex] 
ELSE 
MenuWthiID:= NIL; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TMenuBar. }PutCmdName{(cmdNumber: TCmdNumber; pName: TPString) }; 
Label 1; 
VAR kludge: Str255; 
PROCEDURE DoPut(VAR menu: Menulnfo; itemlndex: INTEGER); 
BEGIN 
Setitem( menu, itemlndex, @kludge) 
Goto 1; 
END; 
BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
XferLeft(POINTER(ORD( pName)), @kl udge, LENGTH( pName%*) +1) 
InAl | MenusDo( TRUE, cmdNumber, DoPut); 
InAll MenusDo(FALSE, cmdNumber, DoPut); 
1: {$IFC fTrace}EP; {$ENDC} 
END; 


( FARR KK KK KX 
{$8 SgABCi ni } 
PROCEDURE {TMenuBar. }SetupGrMenu( menul D: INTEGER; width, height: INTEGER 
newChooseProc, newDrawProc: Ptr); 
{if either proc is NIL, don't change the current value 
if either width or height is <= 0, don't change the current value 
when the menu is first read in, it is setup to behave like a standard text menu} 
VAR menulndex: INTEGER 


BEGIN 
{$1 FC fTrace}BP( 7); {$ENDC} 
menul ndex := FindMenu( menul D); 


1F menulndex > 0 THEN 
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002348 WITH wmgrMenus[menul ndex] DO 
002349 BEGIN 

002350 1F width > 0 THEN 

002351 menuWidth := width; 
002352 IF height > 0 THEN 

002353 menuHei ght := height 
002354 1F newChooseProc <> NIL THEN 
002355 chooseProc := newChooseProc 
002356 1F newDrawProc <> NIL THEN 
002357 drawProc := newDrawProc 
002358 END; 

002359 {$IFC fTrace}EP; {$ENDC} 

002360 END; 


002361 {$$ SgABCres} 
002362 *#*kREKRHKH) 


002363 

002364 

002365 {$$ sRes} 

002366 PROCEDURE {TMenuBar. }Unl oad 

002367 VAR i: INTEGER 

002368 BEGIN 

002369 {$IFC fTrace}BP(7); {$ENDC} 
002370 Cl ear MenuBar 

002371 FOR i := 1 TO SELF. numMenus DO 
002372 SELF.isLoaded[i] := FALSE: 
002373 {$I1FC fTrace}EP; {$ENDC} 
002374 END; 

002375 

002376 

002377 {$8 SgABCi ni } 

002378 END; 

002379 {$8 SgABCres} 

002380 

002381 


002382 {$lFC LibraryVersion <= 20 AND FALSE} {do it this way in case we need it back for the Pepsi version} 
002383 METHODS OF TFont 


002384 

002385 

002386 {$8 SgABCi ni } 

002387 FUNCTION {TFont. }CREATE{(object: TObject; heap: THeap; itsFamily: INTEGER): TFont}; 
002388 BEGIN 

002389 {$I1FC fTrace}BP(7); {$ENDC} 

002390 IF object = NIL THEN 

002391 object := NewObject(heap, THISCLASS) 
002392 SELF := TFont(object); 

002393 

002394 SELF.family := itsFamily 

002395 {$IFC fTrace}EP; {$ENDC} 
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002402 
002403 
002404 
002405 
002406 
002407 
002408 
002409 
002410 {$8 


002411 END; 


002412 {$$ 
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END; 
{$S SgABCres} 


{$1 FC fDebugMet hods} 
{$S SgABCdbg} 
PROCEDURE {TFont. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 
Field('family: I NTEGER') 
END; 
{$S SgABCres} 
{$ENDC} 


SgABCi ni } 
SgABCres} 


002413 {$ENDC} 


002414 
002415 
002416 
002417 


End of File -- 


Lines: 2417 Characters: 73342 


Apple Lisa ToolKit 3.0 Source Code Listing -- 270 of 1012 


Apple Lisa Computer Technical Information 


000001 {INCLUDE FILE UABC5 -- | MPLEMENTATION OF UABC} 

000002 {Copyright 1983, 1984, Apple Computer, Inc. } 

000003 

000004 {TPanel - TBand- TPane- TMar gi nPad- TBodyPad-TScroller-TScrol| Bar} 

000005 

000006 {changed 05/11/84 11:25 In TPanel.MoveSplitBefore, if we are creating a new split check the new band's 
000007 ViewLCd after creation; if not the same as what we passed in, invalidate the 
000008 new band's innerRect. } 

000009 

000010 

000011 


000012 {$$ sCldinit} 
000013 PROCEDURE InvalDiffRect(ri, r2: Rect); {invalidate rl - r2} 


000014 VAR dummyRect: Rect; 

000015 rgnl: RgnHandl e; 
000016 rgn2: RgnHandl e; 
000017 

000018 BEGIN 

000019 {$1 FC fTrace}BP(5); {$ENDC} 
000020 1F EmptyRect(r1) THEN 
000021 {nothing to do} 

000022 ELSE |F SectRect(ri, r2, dummyRect) THEN 
000023 BEGIN 

000024 rgnl := NewRgn; 

000025 rgn2 := NewRgn; 

000026 RectRgn(rgnl, r1) 
000027 RectRgn(rgn2, r2) 
000028 DiffRgn(rgni, rgn2, rgnl) 
000029 Inval Rgn(rgnl); 

000030 Di sposeRgn(rgnl); 
000031 Di sposeRgn(rgn2); 
000032 END 

000033 ELSE 

000034 Inval Rect(rl); 

000035 

000036 {$I FC fTrace}EP; {$ENDC} 
000037 END; 

000038 

000039 

000040 METHODS OF TPanel 

000041 

000042 

000043 {$8 SgABCi ni } 
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000044 FUNCTION {TPanel.}CREATE{(object: TObject; heap: THeap; itsWindow: TWindow 
000045 minHei ght, minWdth: INTEGER; itsVAbilities, itsHAbilities: TAbilities) 
000046 : TPanel }: 

000047 VAR has Wi nResize: BOOLEAN 

000048 vi ewedLRect: LRect; 

000049 panes: TList; 

000050 bandQuterRect: Rect; 

000051 vhs: VHSel ect; 

000052 scroll Bar: TScroll Bar 

000053 scroller: TScroller; 

000054 band: TBand; 

000055 bandList: TList {OF TBand}; 

000056 aPane: TPane; 

000057 BEGIN 

000058 {$IFC fTrace}BP(7); {$ENDC} 

000059 IF object = NIL THEN 

000060 object := NewObject(heap, THI SCLASS) 

000061 SELF := TPanel (obj ect); 

000062 

000063 IF aSplit IN itsVAbilities THEN 

000064 itsVAbilities := itsVAbilities + [aBar]; 
000065 IF aSplit IN itsHAbilities THEN 

000066 itsHAbilities := itsHAbilities + [aBar]; 
000067 

000068 WITH SELF DO 

000069 BEGIN 

000070 window := itsWindow 

000071 view := NIL: 

000072 currentView := NIL; 

000073 selection := NIL: 

000074 undoSelection := NIL: 

000075 mi ninnerDiagonal.v := mi nHei ght; 

000076 mininnerDiagonal.h := minWidth; 

000077 abilities[v] := itsVAbilities 

000078 abilities[h] := itsHAbilities 

000079 previewMode := mPrvwOff; 

000080 paginatedView := NIL; 

000081 parentBranch := NIL; 

000082 resizeBranch := NIL; 

000083 scroll Bars[v] := NIL; {so GetBorder (called by SetOuterRect below) won't blow up} 
000084 scroll Bars[h] := NIL; {ditto} 

000085 

000086 {$H- } 

000087 Set Pt(tlSideBandSize, -1, -1); {+++ LSR +++} 
000088 Set Pt(brSideBandSize, -1, -1); {+++ LSR +++} 
000089 {$H+} 

000090 

000091 deletedSplits := NIL; 
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000092 END; 

000093 

000094 SELF.zoomed := FALSE; 

000095 WITH SELF.zoomFactor DO 

000096 {$H- } BEGIN 

000097 SetPt(numerator, 1, 1); 

000098 SetPt(denominator, 1, 1) 

000099 {$H+} END: 

000100 

000101 SELF. SetOuterRect(itsWindow. outerRect); 

000102 

000103 noPad. RectToLRect(SELF.innerRect, viewedLRect); 
000104 panes := TList.CREATE(NIL, heap, 1) 

000105 SELF. panes := panes 

000106 aPane := SELF.NewPane(heap, SELF.innerRect, viewedLRect) 
000107 WITH SELF. I astClick DO 

000108 BEGIN 

000109 gotPane := TRUE; 

000110 clickPane := aPane 

000111 END; 

000112 SELF. panes. | nsLast(aPane) 

000113 

000114 bandOuterRect := SELF.innerRect; 

000115 InsetRect(bandOuterRect, -1, -1); 

000116 

000117 FOR vhs := v TO h DO 

000118 BEGIN 

000119 scroll Bar := TScrol!l Bar. CREATE(NIL, heap, vhs, bandOuterRect, aBar IN SELF. abilities[vhs]); 
000120 SELF.scrollBars[vhs] := scroll Bar 

000121 scroller := scroll Bar. first Box; 

000122 band := SELF.NewBand( heap, SELF.innerRect, scroller, vhs); 
000123 band, panes. InsLast(SELF. panes. First); 
000124 bandList := TList.CREATE(NIL, heap, 1) 
000125 bandList.InsLast( band); 

000126 SELF. bands[vhs] := bandList; 

000127 END; 

000128 

000129 IF itsWindow. panel Tree = NIL THEN {The first panel gets inserted automatically} 
000130 BEGIN 

000131 itsWndow. panel Tree := SELF; 

000132 itsWndow, panels. I nsLast (SELF) 

000133 

000134 itsWndow.selectPanel := SELF; 

000135 itsWndow.clickPanel := SELF; 

000136 

000137 SELF. Deci deAbout Bars( SELF. outerRect); 
000138 END; 

000139 {$I1FC fTrace}EP; {$ENDC} 
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END; 
{$S SgABCres} 


{$5 SgABCi ni } 
PROCEDURE {TPanel. }Free 
VAR vhs: VHSelect; 
BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
Free( SELF. selection); 
Free( SELF. undoSel ection); 
Free( SELF. vi ew) 
IF SELF.currentView <> SELF. view THEN 
Free( SELF. current View); 
FOR vhs := v TO h DO 
BEGIN 
SELF. bands[ vhs]. Free 
SELF. scroll Bars[vhs]. Free 
END; 
SELF. panes. Free; 
Free(SELF.deletedSplits); 
TArea. Free; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$1 FC fDebugMet hods } 

{$S SgABCdbg} 

PROCEDURE {TPanel.}Fields{( PROCEDURE Field(nameAndType: $255))}; 

BEGIN 
TArea. Fields( Field); 
Field(' window: TWindow'); 
Field(' panes: TList'); 
Field('currentView: TView'); 
Field('view: TView'); 
Field('paginatedView: TPaginatedVi ew’); 
Field('selection: TSelection') 
Field('undoSelection: TSelection'); 
Field('bands: ARRAY [0..1] OF TList'); 
Field('scroll Bars: ARRAY [0..1] OF TScrollBar'); 
Field('abilities: ARRAY [0..1] OF Byte'); 
Field('minlnnerDiagonal: Point'); 
Field('resizeBranch: TBranchArea'); 
Field('zoomed: BOOLEAN' ) 


Field('zoomFactor: RECORD numerator: Point; denominator: Point END'); 


Field('previewMode: Byte'); 
Field(''); 
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000188 Field('lastClick: RECORD gotPane: BOOLEAN; clickPane: TPane; END') 
000189 Field('contentRect: Rect'); 

000190 Field('tlSideBandSize: Point') 

000191 Field('brSideBandSize: Point') 

000192 Field('deletedSplits: TArray') 

000193 Field(''); 

000194 END; 

000195 {$S SgABCres} 

000196 {$ENDC} 

000197 

000198 

000199 {$$ sRes} 

000200 PROCEDURE {TPanel. }AutoScroll {(mousePt: Point) }; 

000201 VAR vhs: VHSel ect; 

000202 mouseCd: INTEGER 

000203 f: INTEGER; 

000204 deltaLPt: LPoint; 

000205 pane: TPane; 

000206 r: Rect; 

000207 BEGIN 

000208 {$I1FC fTrace}BP(7); {$ENDC} 

000209 SELF. current View. GetStdScroll(deltaLPt) 

000210 FOR vhs := v TO h DO 

000211 BEGIN 

000212 mouseCd := mousePt. vh[vhs] 

000213 1F NOT (aScroll IN SELF. abilities[vhs]) THEN 

000214 f := 0 

000215 ELSE 

000216 1F mouseCd < SELF. contentRect.topLeft.vh[vhs] THEN {+++ LSR +++} 
000217 fis-l 

000218 ELSE 

000219 1F mouseCd > SELF. contentRect. botRight.vh[ vhs] THEN {+++ LSR +++} 
000220 f isl 

000221 ELSE 

000222 f := 0; 

000223 deltaLPt.vh[vhs] := f * deltaLPt. vh[ vhs] 

000224 END; 

000225 

000226 {Find the pane to scroll; make sure it is not in a side band} 
000227 r := SELF. content Rect; 

000228 InsetRect(r, 1, 1); {Because the outerRects of a side band's panes overlap the contentRect by 1 pixel 
000229 (ChildWithPt checks the outerRect) } 
000230 RectHavePt(r, mousePt); 

000231 pane := TPane(SELF.ChildWthPt(mousePt, SELF. panes, mousePt)); 
000232 pane. Scroll By(deltaLPt); 

000233 {$I1FC fTrace}EP; {$ENDC} 

000234 END: 

000235 
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000236 

000237 {$$ sRes} 

000238 PROCEDURE {TPanel. }Begi nSel ection; {+S W+} 
000239 VAR thisWi ndow: TW ndow; 

000240 compani onW ndow: TW ndow; 

000241 PROCEDURE Desel Panel (obj: TObj ect); 

000242 BEGIN 

000243 TPanel (obj).selection. Deselect; 

000244 END; 

000245 

000246 BEGIN 

000247 {$IFC fTrace}BP(7); {$ENDC} 

000248 SELF. BeSel ect Panel ( TRUE); 

000249 thisWindow := SELF. window; 

000250 compani onWi ndow := NIL; 

000251 IF thisWndow = current Window THEN 

000252 companionWndow:= thisWindow.dialogBox {+SW+} 
000253 ELSE 

000254 1F thisWndow = current Window. dial ogBox THEN 
000255 IF current Window. dial ogBox. downl nMai nWi ndowResponse = di GiveToMai nWi ndow THEN 
000256 compani onWi ndow := current Window; 
000257 

000258 1F companionWindow <> NIL THEN 

000259 BEGIN 

000260 PushFocus: 

000261 compani onW ndow. Focus; 

000262 compani onW ndow. panels. Each( Desel Panel ); 
000263 PopFocus; 

000264 END; 

000265 thisWindow. panels. Each( Desel Panel ); 

000266 {$I1FC fTrace}EP; {$ENDC} 

000267 END; 

000268 

000269 

000270 {$$ sRes} 

000271 PROCEDURE {TPanel.}BeSelectPanel {(inSelectWindow: BOOLEAN) }; 
000272 BEGIN 

000273 {$IFC fTrace}BP(7); {$ENDC} 

000274 IF inSelect Window THEN 

000275 current Window. select Window := SELF. window; 
000276 SELF. window. selectPanel := SELF: 

000277 {$I1FC fTrace}EP; {$ENDC} 

000278 END; 

000279 

000280 

000281 {$S sStartup} 

000282 PROCEDURE {TPanel.}CleanUpPanes{(deleteList: TList)}; 
000283 VAR s: TListScanner: 
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000329 
000330 
000331 


BEGIN 
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pane: TPane; 


bs: TListScanner 
band: TBand; 
vhs: VHSel ect; 


{$I FC fTrace}BP(7); {$ENDC} 
[F SELF.lastClick. got Pane THEN 


Si 


IF deleteList.Pos(0, SELF.lastClick.clickPane) > 0 THEN 
WITH SELF. astClick DO 


BEGIN 

got Pane := FALSE; 

clickPt := clickPane,innerRect.topLeft; {+} 
END; 


= deleteList. Scanner; 


WHILE s.Scan(pane) DO 


BEGIN 
SELF. panes. Del Obj ect(pane, FALSE); 
FOR vhs := v To h DO 
BEGIN 
bs := SELF. bands[vhs]. Scanner 
WHILE bs.Scan(band) DO 
band. panes. Del Obj ect(pane, FALSE) 
END; 
END: 


deleteList. Free 
{$1FC fTrace}EP; {$ENDC} 


END; 


{$S SgABCres} 


{$$ sRes} 
PROCEDURE {TPanel.}ComputeContent Rect; 


BEGIN 


{$1 FC fTrace}BP( 7); {$ENDC} 
WITH SELF DO 


END; 


BEGIN 

{$H- } 

contentRect.topLeft := Point(FPtPlusPt(innerRect.topLeft, t!SideBandSi ze) ) 
contentRect. botRight := Point(FPtMi nusPt(innerRect. botRight, brSideBandSi ze) ) 


InsetRect(contentRect, 1, 1); 


{$H+} 


END; 
{$I1FC fTrace}EP; {$ENDC} 
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{$S sStartup} 


FUNCTION {TPanel.}CursorAt{(mousePt: Point): TCursorNumber}; 
VAR pane: TPane; 
nearestPt: Point; 
BEGIN 


{$I1FC fTrace}BP( 2); {$ENDC} 

I1F NOT RectHasPt(SELF.outerRect, mousePt) THEN 
CursorAt := noCursor 

ELSE 

IF currentDocument = clipboard THEN 
CursorAt := arrowCursor 

ELSE 

IF RectHasPt(SELF.innerRect, mousePt) THEN 
BEGIN 


pane := TPane(SELF.ChildWithPt( mousePt, SELF.panes, nearestPt)); 


CursorAt := pane. CursorAt(mousePt); 
END 

ELSE 
CursorAt := arrowCursor 


{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S SgABCi ni } 
PROCEDURE {TPanel.}DecideAboutBars{(newOuterRect: Rect) }; 


VAR branch: TBranchArea; 
needsBothBars: BOOLEAN 
vhs: VHSel ect; 
BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 

branch := SELF. Fi ndBranchThatlsResi zed 
SELF.resizeBranch := branch; 
needsBothBars := (branch <> NIL) OR 


(Equal Pt(newOuterRect. botRight, SELF. window. outerRect. botRi ght) AND SELF. window. isResizable); 


FOR vhs := v TO h DO 


SELF. scroll Bars[vhs].ChangeVisibility(needsBothBars, zeroRect, SELF. abilities[vhs]); 


SELF. SetOuterRect(newOuterRect); 
{$IFC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$S SgABCcl d} 
FUNCTION {TPanel.}Divide{(vhs: VHSelect; 


fromEdgeOf Panel: INTEGER; units: TUnitsFromEdge 


whoCanResizelt: TResizability; 


mi nSize: INTEGER; itsVAbilities, itsHAbilities: TAbilities): TPanel}; 
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000427 


BEGI 


END; 
{$5 


{$$ 
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VAR itsMinI nner Diag: Point; 

panel: TPanel; {the new panel } 
N 
{$I FC fTrace}BP(7); {$ENDC} 
itsMinlnnerDiag := SELF. mini nnerDi agonal 
itsMinlnnerDiag.vh[vhs] := minSize; 
panel := TPanel. CREATE(NIL, SELF. heap, SELF. window 


itsMinlnnerDiag.v, itsMinlnnerDiag.h, itsVAbilities 
SELF.Insert( panel, vhs, fromEdgeOfPanel, units, whoCanResizelt); 


Divide := panel 
{$I1FC fTrace}EP; {$ENDC} 


SgABCres} 


sScroll } 


PROCEDURE {TPanel.}DoScrolling{(inArea: TArea; itsPane: TPane 


BEGI 


hOk, vOk: BOOLEAN; VAR deltaLPt: LPoint)}; 
{positive scrolls towards end, (0,0) means invalidate only; 
if inArea is a pane then itsPane=inArea 
if inArea is a band then itsPane is any one of the band's panes 
hOk & vOk indicate whether scrolling is allowed in that direction; 
deltaLPt is set to amount actually scrolled by; 


NOTE: assumes we are focused on something at least as big as inArea. } 
VAR viewedLRect: LRect; 


resizing: BOOLEAN; 

scrollableLRect: LRect; 

freedomLRect: LRect; 

deltaPt: Point; 

vhs: VHSel ect; 
N 


{$1FC fTrace}BP( 6); {$ENDC} 
resizing := EqualLPt(deltaLPt, zeroLPt); 


itsPane.GetScrollLimits(viewedLRect, scroll ableLRect); 


LRect Mi nusLRect(scrollableLRect, viewedLRect, freedomLRect); 
LRectHaveLPt(freedomLRect, deltaLPt):; 


1F NOT hOk THEN 
deltaLPt.h := 0 
1F NOT vOK THEN 


itsHAbilities); 
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000428 deltaLPt.v := 0; 

000429 

000430 1F NOT EqualLPt(deltaLPt, zeroLPt) THEN 

000431 BEGIN 

000432 IF resizing OR NOT IsSmall Pt(deltaLPt) THEN 
000433 Inval Rect(inArea.innerRect) 

000434 ELSE 

000435 BEGIN 

000436 itsPane. LDistToDist(deltaLPt, deltaPt); 
000437 Scroll Rect(inArea.innerRect, -deltaPt.h, -deltaPt.v, scroll Rgn); 
000438 Inval Rgn(scrol! Rgn); 

000439 END; 

000440 END; 

000441 {$I1FC fTrace}EP; {$ENDC} 

000442 END; 

000443 

000444 

000445 {$$ sRes} 

000446 FUNCTION {TPanel.}DownAt{(mousePt: Point): BOOLEAN}: 
000447 VAR found: BOOLEAN; 

000448 cant Down: BOOLEAN; 

000449 vhs: VHSel ect; 

000450 outerRect: Rect; 

000451 innerRect: Rect; 

000452 insetContent: Rect; 

000453 growRect: Rect; 

000454 wi ndow: TWi ndow; 

000455 di al ogBox: TDi al ogBox; 

000456 icon: TEnuml cons: 

000457 scroller: TScroller; 

000458 pane: TPane; 

000459 vi ewedLRect: LRect; 

000460 hysteresis: BOOLEAN; 

000461 limitRect: Rect; 

000462 hysterPt: Point; 

000463 ori gPt: Point; 

000464 diffPt: Poi nt; 

000465 nearestPt: Point: 

000466 aheadEvent: Event Record: 

000467 destPanel: TPanel: 

000468 destVi ew: TView; 

000469 1 PtI nVi ew: LPoint; 

000470 received: BOOLEAN; 

000471 mousel nContent: BOOLEAN; {TRUE iff mouse is currently in contentRect} 
000472 

000473 PROCEDURE EnforceHysteresis; 

000474 BEGIN 

000475 diffPt := Point(FPtMinusPt(mousePt, origPt)); 
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SELF.selection, GetHysteresis(hysterPt); 

IF (ABS(diffPt.h) < hysterPt.h) AND (ABS(diffPt.v) < hysterPt.v) THEN 
mousePt := origPt 

ELSE 
hysteresis := FALSE; 

END; 


BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
outerRect := SELF. outerRect; 
innerRect := SELF.innerRect; 
insetContent := SELF.contentRect 
InsetRect(insetContent, 1, 1); 


1F NOT RectHasPt(innerRect, mousePt) THEN {+} 
BEGIN 
found := FALSE; 
FOR vhs := v TO h DO 
1F NOT found THEN 
IF SELF.scroll Bars[vhs].DownAt(mousePt, scroller, icon) THEN 


BEGIN 
SELF. HitScroller(vhs, mousePt, scroller, icon) 
found := TRUE: 
END; 
1F NOT found THEN 


BEGIN 

SetRect(growRect, innerRect.right + 1, innerRect. bottom + 1, 
outerRect.right - 1, outerRect.bottom~ 1) 

IF RectHasPt(growRect, mousePt) THEN 


BEGIN 
SELF. Downl nSi zeBox( mousePt) ; 
found := TRUE: 
process. Remember Command( uResi zePanel ); 
END; 
END; 
DownAt := found: 
END 
ELSE 
BEGIN 


DownAt := TRUE; 

IF currentDocument = clipboard THEN 
process. Stop( phEditCli p) 

ELSE 

BEGIN 

window := SELF. window 

di alogBox := window. dial ogBox; 

1F dialogBox = NIL THEN 
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cantDown := FALSE 
ELSE 
1F dial ogBox. downl nMai nWi ndowResponse = diDismissDialogBox THEN 
BEGIN 
dial ogBox. BeDismissed 
cant Down := FALSE; 
END 
ELSE 
cant Down := (dial ogBox. downl nMainWi ndowResponse = di Refuse); 


IF cant Down THEN 
process, Stop( phDi al ogUp) 


ELSE 


BEGIN 

{$I FC fDbgABC} 

1F SELF.currentView = NIL THEN 
ABCBreak('DownAt with no view set', 0); 

{$ENDC} 


mousel nContent := RectHasPt(insetContent, mousePt); 
pane := TPane(SELF.ChildWithPt( mousePt, SELF.panes, nearestPt)); 


1F mouselnContent THEN 
WITH SELF. I astClick DO 


BEGIN 

gotPane := TRUE; 
clickPane := pane 
END; 


process. Remember Command(uMousePress); 
pane, MouseTrack(mPress, mousePt); 


[F SELF.selection.canCrossPanels THEN 
BEGIN 
pane. Rect ToLRect(window.innerRect, viewedLRect); 


WITH pane.origin DO {$H-} {convert to (0,0)-origined view coordinates} 
OffsetLRect(viewedLRect, h, v); {$H+} 


pane := TPane. CREATE(NIL, SELF. Heap, SELF, window,innerRect, viewedLRect); 
PushFocus: 

pane. Focus; 

SELF. selection. DrawGhost; 

PopFocus; 

END; 
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{Set up some temporaries for the Still Down | oop} 

limitRect := SELF. contentRect; {AutoScroll slop} 

InsetRect(limitRect, -9, -6); {*** should be more lenient at edges of screen ***} 
origPt := mousePt; 

hysteresis := TRUE; 


WHILE still Down do 
BEGIN 
Get Mouse( mousePt); 
{use pane.outerRect in line below, because ChildWthPt checks the outerRect} 
IF NOT (RectHasPt(pane.outerRect, mousePt) OR SELF.selection.canCrossPanels) THEN 
BEGIN 
IF mouselnContent THEN {autoscrolling allowed} 
BEGIN 
IF NOT RectHasPt(limitRect, mousePt) THEN 
BEGIN 
SELF. AutoScroll(mousePt); 
wi ndow. Update( TRUE); 
END; 
RectHavePt(insetContent, mousePt); {force mouse point into contentRect} 
END; 


(**** Do we want this line? Depend on if you want to allow people to down in side band, move into content 
and go back to side band 
mousel nContent := RectHasPt(insetContent, mousePt); 
* KK) 
pane := TPane(SELF.ChildWthPt(mousePt, SELF.panes, mousePt)); 
hysteresis := FALSE; 
END 
ELSE 
IF hysteresis THEN 
EnforceHysteresis 
pane. MouseTrack( mMove, mousePt); 
END; 


1F PeekEvent(aheadEvent) THEN 
BEGIN 
IF aheadEvent. what = buttonUp THEN 
BEGIN 
mousePt := aheadEvent. where; {otherwise, use last polled point} 


{check to see if we've crossed the pane boundary 
use pane, outerRect in line below, because ChildWithPt checks the outerRect} 
1F NOT (RectHasPt(pane.outerRect, mousePt) OR 
SELF.selection.canCrossPanels) THEN 
BEGIN 
IF mouselnContent THEN {force mouse point into contentRect} 
RectHavePt(insetContent, mousePt); 
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pane := TPane(SELF.ChildWthPt(mousePt, SELF. panes, mousePt) ) 
hysteresis := FALSE; 
END; 

RectHavePt(pane.innerRect, mousePt); 

END: 


IF hysteresis THEN 
EnforceHysteresis 
END; 
pane. MouseTrack(mRelease, mousePt); 


IF SELF.selection.canCrossPanels THEN 


BEGIN 
pane. Free; 
destPanel := TPanel (window. ChildWthPt(mousePt, window. panels, nearest Pt) ) 
IF PtlnRect(mousePt, destPanel.innerRect) THEN 
BEGIN 


destView := destPanel. view 
pane := TPane(destPanel.ChildWithPt(mousePt, destPanel. panes, nearestPt)); 


{Account for origin difference between window and pane} 
PushFocus: 
Local ToGI obal ( mousePt); 
pane. Focus; 
Gl obal ToLocal ( mousePt) 
pane. PtToLpt( mousePt, | Pt! nView) 
received := dest View. DoReceive(SELF.selection, | PtinView); 
PopFocus; 
END 

ELSE 
received := FALSE; 

1F NOT received THEN 
SELF. selection. MoveBackToAnchor 

END: 

END; 
END; 


END; 
{$I FC fTrace}EP; {$ENDC} 


{$$ SgABCres} 


{$$ sRes} 
PROCEDURE {TPanel.}Downl nSizeBox{( mousePt: Point) }; 
VAR branch: TBranchArea; 
outerRect: Rect; 
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ol dTopLeft: Point; 

ol dBot Ri ght: Poi nt; 

vhs: VHSel ect; 

mi nPt: Point; 

max Pt: Point; 

elderFirst: BOOLEAN 

mi nExtents: ARRAY [FALSE.. TRUE] OF Point; 
newBot Ri ght: Poi nt; 

newCd: INTEGER; 


BEGIN 

{$IFC fTrace}BP(7); {$ENDC} 

branch := SELF. resizeBranch; 

IF branch <> NIL THEN 
BEGIN 
outerRect := branch. outerRect; 
oldTopLeft := outerRect.topLeft; 
ol dBotRight := outerRect. botRi ght; 
vhs := branch, arrangement 


{don't resize in the orthogonal direction} 
mi nPt := ol dBotRi ght; 

maxPt := ol dBotRi ght; 

{limit resizing in the free direction} 
elderFirst := branch.elderFirst; 


branch. el derChild. Get Mi nExtent(mi nExtents[elderFirst], FALSE); 
branch. youngerChild. Get Mi nExtent(minExtents[ NOT elderFirst], FALSE); 


minPt.vh[vhs] := oldTopLeft.vh[ vhs] 
maxPt.vh[vhs] := ol dBotRight.vh[vhs] - 


{let the user specify the new botRi ght} 


+ mi nExtents[ TRUE]. vh[ vhs] 
mi nExtents[ FALSE]. vh[ vhs] 


ResizeFeedback( mousePt, minPt, maxPt, branch. TopLeftChild. outerRect, 


0, dhSBox, dvSBox, newBotRi ght); 
newCd := newBotRi ght. vh[ vhs] 
1F newCd <> oldBotRight.vh[ vhs] THEN 
branch. Redi vi de( newCd); 


END; 
{$I1FC fTrace}EP; {$ENDC} 


END: 
{$$ sRes} 
FUNCTION {TPanel.}FindBranchThatIsResized{: TBranchArea}; 
VAR child: TArea: 
fini: BOOLEAN; 
parent: TBranchArea: 
BEGIN 
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{$1FC fTrace}BP(7); {$ENDC} 
{ Find the panel branch of which this is the bottomright corner of the top left child } 
child := SELF; 
fini := FALSE: 
REPEAT 
parent :=¢ 
IF parent = 
fini := 
ELSE 
fini := parent. TopLeftChild = child; 
child := parent; 
UNTIL fini 


parent Branch; 
THEN 


FindBranchThatI sResized := NIL; 
IF parent <> NIL THEN 
IF userCanResizelt IN parent. resizability THEN 
FindBranchThat|sResized := parent; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TPanel.}Frame: 
VAR actively: BOOLEAN 


growRect: Rect; 

branch: TBranchArea: 
vhs: VHSel ect; 
{$1FC LibraryVersion > 20} 
icon: Char: 

{$ENDC} 


BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
IF NOT RectsNest(SELF.innerRect, focusRgn**.rgnBBox) THEN 
BEGIN 
TArea. Frame; 
actively := SELF. window. !IsActive 


IF SELF.scrollBars[v].isVisible OR SELF.scrollBars[h].isVisible THEN 
IF NOT Equal Pt( SELF. outerRect.botRight, SELF. window. outerRect. botRight) THEN 
BEGIN {Draw the panel's resize box} 
SetRect(growRect, SELF.innerRect.right, SELF.innerRect. bottom 
SELF. outerRect.right, SELF. outerRect. bottom); 
Fill Rect(growRect, white); 
IF actively THEN 
BEGIN 
branch := SELF. resizeBranch; 
IF branch <> NIL THEN {Draw a resize icon in the box} 
BEGIN 
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000764 {$1FC LibraryVersion <= 20} 
000765 vhs := branch, arrangement; 
000766 InsetRect(growRect, 3, 2); 
000767 growRect. botRight.vh[vhs] := growRect.topLeft.vh[ vhs] + 1; 
000768 PenNor mal 

000769 FrameRect(growRect) 

000770 {$ELSEC} 

000771 Text Font (wmFont); 

000772 TextFace([]); 

000773 MoveTo(growRect. left, growRect.top); 
000774 |F branch. arrangement = v THEN 
000775 icon := CHR( 33) 

000776 ELSE 

000777 icon := CHR( 34); 

000778 DrawChar(icon); 

000779 {$ENDC} 

000780 END; 

000781 END; 

000782 END; 

000783 

000784 FOR vhs := v TO h DO 

000785 IF actively THEN 

000786 SELF. scroll Bars[vhs]. Draw 

000787 ELSE 

000788 SELF. scroll Bars[vhs]. Erase 

000789 END; 

000790 {$I FC fTrace}EP; {$ENDC} 

000791 END; 

000792 {$8 SgABCres} 

000793 

000794 

000795 {$$ sRes} 

000796 PROCEDURE {TPanel.}GetBorder{(VAR border: Rect) }; 
000797 VAR vhs: VHSel ect 

000798 hasBar: BOOLEAN: 

000799 d: ARRAY[ VHSelect] OF INTEGER; 

000800 BEGIN 

000801 {$I FC fTrace}BP( 3); {$ENDC} 

000802 FOR vhs := v TO h DO 

000803 BEGIN 

000804 IF SELF.scrollBars[vhs] = NIL THEN 

000805 hasBar := FALSE 

000806 ELSE 

000807 hasBar := SELF.scroll Bars[orthogonal[vhs]].isVisible; 
000808 

000809 I1F hasBar THEN 

000810 d[vhs] := dptSbox.vh[ vhs] 

000811 ELSE 
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000812 IF SELF. outerRect. botRight.vh[vhs] = SELF. window. outerRect. bot Right. vh[ vhs] THEN 
000813 d[vhs] := 1 

000814 ELSE 

000815 d[vhs] := 0: 

000816 END; 

000817 SetRect(border, -1, -1, d[h], d[v]); 
000818 {$I1FC fTrace}EP; {$ENDC} 

000819 END; 

000820 

000821 

000822 {$S sStartup} 

000823 PROCEDURE {TPanel.}Get MinExtent{(VAR minExtent: Point; windowlsResizinglt: BOOLEAN) }; 
000824 VAR borderRect: Rect; 

000825 BEGIN 

000826 {$1 FC fTrace}BP(9); {$ENDC} 

000827 Rect Mi nusRect(SELF.outerRect, SELF.contentRect, borderRect); 
000828 mi nExtent := Point(FPtPlusPt(SELF. mininnerDiagonal, Point(FDiagRect(borderRect)))); 
000829 {$I1FC fTrace}EP; {$ENDC} 

000830 END; 

000831 {$S SgABCres} 

000832 

000833 

000834 {$$ sCldl nit} 

000835 PROCEDURE {TPanel.}HaveView{(view: TVi ew) }; 
000836 VAR s: TListScanner 

000837 pane: TPane; 

000838 selection: TSelection; 

000839 saveMode: TPrevi ewMode 

000840 BEGIN 

000841 {$I1FC fTrace}BP(7); {$ENDC} 

000842 saveMode := SELF. previ ewMode 

000843 SELF. previewMode := mPrvw0ff; 

000844 SELF.view := view 

000845 SELF. currentView := view 

000846 

000847 s := SELF. panes. Scanner 

000848 WHILE s.Scan(pane) DO 

000849 pane, HaveVi ew( view); 

000850 

000851 view. Bel nPanel (SELF); 

000852 

000853 IF SELF.selection = NIL THEN 

000854 BEGIN 

000855 selection := view. NoSel ection; 
000856 SELF.selection := selection: 

000857 END 

000858 ELSE 

000859 SELF. selection. HaveVi ew( vi ew) 
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000860 
000861 
000862 
000863 
000864 
000865 
000866 
000867 
000868 
000869 
000870 
000871 
000872 
000873 
000874 
000875 
000876 
000877 
000878 
000879 
000880 
000881 
000882 
000883 
000884 
000885 
000886 
000887 
000888 
000889 
000890 
000891 
000892 
000893 
000894 
000895 
000896 
000897 
000898 
000899 
000900 
000901 
000902 
000903 
000904 
000905 
000906 
000907 


{$8 
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IF SELF.undoSelection = NIL THEN 
BEGIN 
selection := view. NoSel ection; 
SELF. undoSelection := selection: 
END 

ELSE 
SELF. undoSel ection. HaveVi ew( view); 


SELF. Previ ew(saveMode) ; 
SELF. Resizelnside(SELF.innerRect); {mainly needed to force panes of a new one-panel window to size} 


IF view.isPrintable THEN 
|F SELF. window. panel ToPrint = NIL THEN 
SELF. window. panel ToPrint := SELF; 


{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sRes} 
PROCEDURE {TPanel. }Highlight{(selection: TSelection; highTransit: THighTransit) }; 


PROCEDURE HiliteOnThePad 

BEGIN 
selection. Hi ghlight(highTransit); 

END; 


BEGI 
FC f MaxTrace}BP( 1); {$ENDC} 
FC fMaxTrace}EP: {$ENDC} 


N 
{$l 
{$l 
SELF. OnAl | PadsDo( HiliteOnThePad); 


$ 
$ 
E 
END; 

SgABCres} 


{$$ sScroll} 
PROCEDURE {TPanel.}HitScroller{(vhs: VHSelect; mousePt: Point; scroller: TScroller; icon: TEnuml cons) }: 
VAR ol dThumbPos: INTEGER 


newThumbPos: INTEGER; 
deltaLStd: LPoi nt; 
band: TBand; 
newSkwr Cd: INTEGER; 
aScroller: TScroller 
prevScroller: TScroller; 


BEGIN 
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000908 {$I1FC fTrace}BP(7); {$ENDC} 

000909 band := scroller. band 

000910 CASE icon OF 

000911 i Skewer: 

000912 BEGIN 

000913 scroller. TrackSkewer(mousePt, newSkwrCd, aScroller, prevScroller); 
000914 SELF. MoveSplitBefore(scroller, newSkwrCd); 

000915 process. Remember Command(uSplitting) 

000916 END; 

000917 i Thumb: 

000918 BEGIN 

000919 scroller. TrackThumb( mousePt, oldThumbPos, newThumbPos) 
000920 1F ol dThumbPos <> newThumbPos THEN 

000921 BEGIN 

000922 band. ThumbTo( newThumbPos) 

000923 scroller. MoveThumb( band. ThumbPos) 

000924 END; 

000925 process. Remember Command(uThumbi ng) 

000926 END; 

000927 iScroll Back, iScroll Fwd, iFlipBack, iFlipFwd: 

000928 BEGIN 

000929 scroller. Filllcon(icon, TRUE); 

000930 SELF. currentView. Get StdScroll(deltaLStd) 

000931 Set upMvThumb( POI NTER(scroller.sBoxl D)) 

000932 REPEAT 

000933 band. Scroll Step(icon, deltaLStd.vh[vhs]); 

000934 SELF. wi ndow. Updat e( TRUE) 

000935 PenNor mal 

000936 MoveThumb( band. ThumbPos); 

000937 UNTIL NOT Still Down; 

000938 scroller. Filllcon(icon, FALSE); 

000939 process. Remember Command(uScrolling) 

000940 END; 

000941 END; 

000942 {$I1FC fTrace}EP; {$ENDC} 

000943 END; 

000944 

000945 

000946 {$S SgABCcl d} 

000947 PROCEDURE {TPanel.}Insert{(panel: TPanel; vhs: VHSelect; 

000948 fromEdgeOfPanel: INTEGER; units: TUnitsFromEdge 
000949 whoCanResizelt: TResizability) }; 

000950 

000951 VAR window: TW ndow 

000952 elderFirst: BOOLEAN; {TRUE if fromEdgeOfPanel <0 (new panel below or to right of old)} 
000953 my OuterRect: Rect; {SELF. outerRect } 

000954 my Size: INTEGER; {Length of SELF beforehand} 
000955 itsOuterRect: Rect; {will be panel. outerRect} 
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000956 
000957 
000958 
000959 
000960 
000961 
000962 
000963 
000964 
000965 
000966 
000967 
000968 
000969 
000970 
000971 
000972 
000973 
000974 
000975 
000976 
000977 
000978 
000979 
000980 
000981 
000982 
000983 
000984 
000985 
000986 
000987 
000988 
000989 
000990 
000991 
000992 
000993 
000994 
000995 
000996 
000997 
000998 
000999 
001000 
001001 
001002 
001003 


BEGI 


END; 
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newsSi ze: INTEGER; {Proposed length of the new panel (in the vh direction) } 
cdl nWi ndow: | NTEGER; {the coordinate of myOuterRect that is changing} 
myFormer Parent: TBranchArea: 
ourNewParent: TBranchArea 

N 


{$I1FC fTrace}BP(7); {$ENDC} 
window := SELF. window 

window. panels. I nsLast(panel ); 
panel. window := window 


elderFirst := fromEdgeOfPanel < 0; 
myOuterRect := SELF. outerRect; 

mySize := LengthRect(myOuterRect, vhs); 
itsOuterRect := myOuterRect; 


newSize := ABS(fromEdgeOf Panel ) 


IF units = percentFromEdge THEN {convert to pixelsFromEdge} 
newSize := LintDivint(Li nt Mull nt(mySize, newSize), 100) 


newSize := Max(1, Min(newSize, myOuterRect. botRight.vh[vhs] - myOuterRect.topLeft.vh[vhs] - 1)); 


IF elderFirst THEN 
newSize := -newSize 


cdi nWi ndow := TRectCoords(myOuterRect)[elderFirst].vh[vhs] + newSize 
TRectCoords( myOuterRect)[elderFirst].vh[vhs] := cdl nWndow 
TRectCoords(itsOuterRect)[NOT elderFirst].vh[vhs] := cdl nWindow 


myFormerParent := SELF. parent Branch; 
ourNewParent := TBranchArea. CREATE(NIL, SELF.Heap, vhs, elderFirst, whoCanResizelt, SELF, panel); 


IF myFormerParent = NIL THEN 
window. panel Tree := ourNewParent 
ELSE 
myFormerParent. Repl aceChild(SELF, ourNewParent); 


panel, SetOQuterRect(zeroRect); {since the panel is not on the screen right now 
it shouldn't have any size} 

panel. ResizeOutside(itsOuterRect); 

SELF. Resi zeQutsi de( myOuterRect); 


{Just in case some panel is below its mimimum size, let the window expand if needed} 


wi ndow. Resi ze( FALSE); 
{$I1FC fTrace}EP; {$ENDC} 
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001004 
001005 
001006 
001007 
001008 
001009 
001010 
001011 
001012 
001013 
001014 
001015 
001016 
001017 
001018 
001019 
001020 
001021 
001022 
001023 
001024 
001025 
001026 
001027 
001028 
001029 
001030 
001031 
001032 
001033 
001034 
001035 
001036 
001037 
001038 
001039 
001040 
001041 
001042 
001043 
001044 
001045 
001046 
001047 
001048 
001049 
001050 
001051 
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{$S SgABCres} 


{$S SgDRWres} 
PROCEDURE {TPanel. }I nvalidate; 
BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
PushFocus; 
SELF. wi ndow. Focus 
Inval Rect(SELF.innerRect); 
PopFocus; 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$S SgABCres} 
PROCEDURE {TPanel. }Il nvalLRect{(1RectIl nView: LRect) };: 


PROCEDURE I nval OnThePad 
BEGIN 

thePad. I nval LRect(| Rect! nVi ew); 
END; 


BEGIN 

{$I FC fTrace}BP(7); {$ENDC} 

SELF. OnAl | PadsDo(I nval OnThePad); 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$8 SgABCcl d} 
PROCEDURE {TPanel.}MakeBand{(vhs: VHSelect; scroller, prevScroller: TScroller)}; 
VAR prevBand: TBand 
band: TBand; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
prevBand := prevScroller. band 
band := SELF. NewBand(SELF.Heap, zeroRect, scroller, vhs) 
band. panes. Become( prevBand. panes. Cl one( SELF. Heap) ) 
SELF. bands[vhs]. |] nsAt( SELF. bands[vhs].Pos(0, prevBand) + 1, band) 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S sSplit} 
PROCEDURE {TPanel.}MoveSplitBefore{(scroller: TScroller; newSkwrCd: INTEGER) }; 
VAR vhs: VHSel ect; 
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001052 
001053 
001054 
001055 
001056 
001057 
001058 
001059 
001060 
001061 
001062 
001063 
001064 
001065 
001066 
001067 
001068 
001069 
001070 
001071 
001072 
001073 
001074 
001075 
001076 
001077 
001078 
001079 
001080 
001081 
001082 
001083 
001084 
001085 
001086 
001087 
001088 
001089 
001090 
001091 
001092 
001093 
001094 
001095 
001096 
001097 
001098 
001099 
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Information 


outsideContent: BOOLEAN 
hsb: THsb: 
prevHsb: THsb; 
prevScroller: TScroller; 
nextScroller: TScroller; 
otherBand: TBand; 
band: TBand; 

ol dSkwrCd: INTEGER; 
newVi ewLCd: LONGI NT; 
viewDel taLCd: LONGI NT; {- gb} 
sbRect: Rect; 
newSkwr Pt: Point; 
sbList: TSbLi st; 
limitRect: Rect; 

r: Rect; 


PROCEDURE InvalScrollers(firstBand, lastBand: TBand); 

VAR firstSbRect: Rect; 
lastSbRect: Rect; 

BEGIN 
firstBand.scroller. GetSize(firstSbRect); 
lastBand. scroller. GetSize(lastSbRect); 
UnionRect(firstSbRect, lastSbRect, firstSbRect); 
Inval Rect(firstSbRect); 

END; 


BEGIN 


{$I FC fTrace}BP(7); {$ENDC} 
vhs := scroller. Scroll Dir; 


outsideContent := TRUE; 
WITH SELF.contentRect DO 
IF newSkwrCd <= topLeft.vh[vhs] THEN 
newSkwrCd := topLeft.vh[vhs] - 1 
ELSE | F newSkwrCd >= botRight.vh[ vhs] THEN 
newSkwrCd := botRight.vh[vhs] + 1 
ELSE 
outsideContent := FALSE: 


hsb := Pointer(scroller.sBox! D) 
prevHsb := HsbPrev(hsb) 


IF prevHsb = hsbNil THEN 
BEGIN 
prevScroller := NIL; 


{make scroller refer to the scroller we are going to split} 


scroller. GetSize(sbRect); 
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001100 
001101 
001102 
001103 
001104 
001105 
001106 
001107 
001108 
001109 
001110 
001111 
001112 
001113 
001114 
001115 
001116 
001117 
001118 
001119 
001120 
001121 
001122 
001123 
001124 
001125 
001126 
001127 
001128 
001129 
001130 
001131 
001132 
001133 
001134 
001135 
001136 
001137 
001138 
001139 
001140 
001141 
001142 
001143 
001144 
001145 
001146 
001147 
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newSkwr Pt. vh[ vhs] := newSkwrCd 
newSkwrPt.vh[orthogonal[vhs]] := sbRect.topLeft.vh[orthogonal[vhs]]; 


PreSbList(sbList, scroller. scroll Bar); 
hsb := HsbFromPt(sbList, newSkwrPt); 
PostSbList(sbList, scroller.scroll Bar); 


IF (hsb = hsbNil) {user started to create a new split but changed his mind} OR 
outsideContent {new split would be in a side band} THEN 


ELSE 


scroller := NIL {user started to create a new split but changed his mind} 
ELSE 
scroller := TScroller(RefconSb(hsb)); 
END 
BEGIN 
prevScroller := TScroller(RefconSb( prevHsb) ); 


{don't allow the new position of split to cross another split} 
FixRLimits(hsb, l|imitRect); 

WITH limitRect DO 

newSkwrCd := Max(topLeft.vh[ vhs], Min(botRight.vh[vhs], newSkwrCd)); 
END; 


IF scroller <> NIL THEN 


BEGIN 
scroller. GetSize(sbRect); 
ol dSkwrCd := sbRect.topLeft.vh[ vhs] 


WITH SELF.contentRect DO 
IF oldSkwrCd <= topLeft.vh[vhs] THEN 
oldSkwrCd := topLeft.vh[vhs] - 1 
ELSE IF oldSkwrCd >= botRight.vh[ vhs] THEN 
oldSkwrCd := botRight.vh[vhs] + 1; 


1F newSkwrCd <> ol dSkwrCd THEN 
BEGIN 
band := scroller. band 
viewDeltaLCd := newSkwrCd - ol dSkwrCd 
|F SELF.zoomed THEN { if zoomed then adjust viewDeltaLCd accordingly } 
WITH SELF. zoomFactor DO 


{$H- } viewDeltaCd := LintOvrint(LintMull nt(viewDeltaLCd, denominator.vh[vhs]), 


{-gb +++LSR+++} numerator. vh[vhs]); 
{$H- } 
newViewLCd := band. ViewLCd + viewDeltaLCd 
IF prevScroller = NIL THEN 
BEGIN {new band} 
IF hsb <> hsbNil THEN 
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001148 BEGIN 

001149 Inval Scrollers( band, band) 

001150 

001151 scroller. SplitAt(newSkwrCd, nextScroller); 

001152 

001153 SELF. ResizeBand(vhs, band, band. ViewLCd, FALSE) 
001154 SELF. MakeBand(vhs, nextScroller, scroller); 

001155 otherBand := nextScroller. band 

001156 SELF. ResizeBand(vhs, otherBand, newViewLCd, FALSE) 
001157 

001158 {must invalidate now (special case) } 

001159 IF otherBand. ViewLCd <> newViewLCd THEN {the new band scrolled a bit} 
001160 Inval Rect(otherBand. innerRect); 

001161 

001162 Pt 2Rect(band.innerRect. botRight, otherBand.innerRect.topLeft, r); 
001163 Inval Rect(r); 

001164 

001165 SELF. RepaneOrt hogonal Bands(vhs) ; 

001166 SELF. RemakePanes; 

001167 END; 

001168 END 

001169 ELSE 

001170 BEGIN {resize or delete band} 

001171 {lf new position of split is outside the contentRect, make it go away} 
001172 IF outsideContent THEN 

001173 WITH limitRect DO 

001174 IF newSkwrCd <= SELF. contentRect.topLeft.vh[ vhs] THEN 
001175 newSkwrCd := topLleft.vh[ vhs] 

001176 ELSE 

001177 newSkwrCd := botRight.vh[vhs] 

001178 

001179 scroller. ResplitAt(newSkwrCd, prevScroller); 

001180 otherBand := prevScroller. band 

001181 Inval Scrollers(otherBand, band) 

001182 

001183 SELF. ResizeBand(vhs, otherBand, otherBand. ViewLCd, TRUE) 
001184 SELF. ResizeBand(vhs, band, newViewLCd, TRUE) 

001185 END; 

001186 END; 

001187 END; 

001188 {$IFC fTrace}EP; {$ENDC} 

001189 END; 

001190 

001191 

001192 {$$ sCldil nit} 

001193 FUNCTION {TPanel.}NewBand{( heap: THeap; mylnnerRect: Rect; 

001194 scroller: TScroller; vhs: VHSelect): TBand}; 
001195 BEGIN 
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001196 
001197 
001198 
001199 
001200 
001201 
001202 
001203 
001204 
001205 
001206 
001207 
001208 
001209 
001210 
001211 
001212 
001213 
001214 
001215 
001216 
001217 
001218 
001219 
001220 
001221 
001222 
001223 
001224 
001225 
001226 
001227 
001228 
001229 
001230 
001231 
001232 
001233 
001234 
001235 
001236 
001237 
001238 
001239 
001240 
001241 
001242 
001243 
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{$I1FC fTrace}BP(7); {$ENDC} 
NewBand := TBand.CREATE(NIL, heap, SELF, mylnnerRect, scroller, vhs) 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$S SgABCcl d} 
FUNCTION {TPanel. }NewStatusView{(object: TObject; itsExtent: LRect): TView}; 
BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
NewStatusView := TView. CREATE(object, SELF.Heap, SELF, itsExtent, NIL, zeroLRect, 
FALSE, screenRes, TRUE); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sCldi nit} 
FUNCTION {TPanel. }NewView{(object: TObject; itsExtent: LRect; itsPrintManager: TPrint Manager 
itsDfltMargins: LRect; itsFitPerfectl yOnPages: BOOLEAN): TView}; 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 


Newiew := TView. CREATE(object, SELF.Heap, SELF, itsExtent, itsPrintManager, itsDfltMargins 


itsFitPerfectl yOnPages, screenRes, TRUE); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S sStartup} 
FUNCTION {TPanel.}NewPane{(heap: THeap; innerRect: Rect; viewedLRect: LRect): TPane}; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
NewPane := TPane.CREATE(NIL, heap, SELF, innerRect, viewedLRect); 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCcl d} 
FUNCTION {TPanel.}OKToDrawi n{(IRectIl nView: LRect): BOOLEAN}; 
BEGIN 

{$IFC fTrace}BP( 6); {$ENDC} 

1F NOT SELF. view. OKToDrawin(| Rect! nView) THEN 

OKToDrawin := FALSE 
ELSE 
|F SELF.previewMode = mPrvwBreaks THEN 
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001244 OKToDrawin := FALSE {This will be smarter some day} 
001245 ELSE 

001246 OKToDrawin := TRUE; 

001247 {$I1FC fTrace}EP; {$ENDC} 

001248 END; 

001249 

001250 

001251 {$8 SgABCres} 

001252 PROCEDURE {TPanel. }OnAl | PadsDo{( PROCEDURE DoOnThePad) }; 
001253 VAR panes: TList {OF TPane}; 

001254 pane: TPane 

001255 

001256 PROCEDURE YouDo(obj: TObj ect); 

001257 BEGIN 

001258 TPad( obj). Focus; 

001259 DoOnThePad; 

001260 END; 

001261 

001262 PROCEDURE YouDoOnPages(obj: TObject); 

001263 BEGIN 

001264 TPane( obj). Focus; 

001265 SELF. pagi natedView. DoOnPages(NOT SELF. pagi natedView. working! nMargins, DoOnThePad); 
001266 {i.e., if we're operating in the margins, do NOT focus on the interior} 
001267 END; 

001268 

001269 BEGIN 

001270 {$IFC fTrace}BP(7); {$ENDC} 

001271 panes := SELF. panes 

001272 pane := TPane(panes. First); 

001273 PushFocus 

001274 

001275 IF (panes.Size = 1) AND (SELF. previewMode <> mPrvwMargins) THEN 
001276 BEGIN 

001277 pane. Focus; 

001278 DoOnThePad; 

001279 END 

001280 ELSE 

001281 BEGIN 

001282 1F SELF.previewMode = mPrvwMargins THEN 

001283 SELF. panes. Each( YouDoOnPages) 

001284 ELSE 

001285 SELF. panes. Each( YouDo); 

001286 END; 

001287 

001288 PopFocus; 

001289 {$IFC fTrace}EP; {$ENDC} 

001290 


END; 
001291 {$S SgABCres} 
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001292 

001293 

001294 {$S sRes} 

001295 FUNCTION {TPanel.}PaneShowi ng{(anLRect: LRect): TPane}; 
001296 VAR pane: TPane; 

001297 S! TListScanner: 

001298 vi ewedLRect: LRect; 

001299 scrollableLRect: LRect; 

001300 BEGIN 

001301 {$I1FC fTrace}BP(7); {$ENDC} 

001302 PaneShowing := NIL; 

001303 

001304 s := SELF. panes. Scanner 

001305 WHILE s.Scan(pane) DO 

001306 BEGIN 

001307 pane, GetScrollLimits(viewedLRect, scrollableLRect); 
001308 WITH anLRect DO 

001309 BEGIN 

001310 LRectHaveLPt(scrollableLRect, topLeft); 
001311 LRectHaveLPt(scrollableLRect, botRi ght); 
001312 END; 

001313 

001314 WITH viewedLRect DO 

001315 IF top <= anLRect. bottom THEN 

001316 1F bottom >= anLRect.top THEN 
001317 IF left <= anLRect.right THEN 
001318 IF right >= anLRect.left THEN 
001319 BEGIN 

001320 s. Done; 

001321 PaneShowi ng := pane 
001322 END; 

001323 END; 

001324 {$1FC fTrace}EP; {$ENDC} 

001325 END; 

001326 

001327 

001328 {$S sRes} 

001329 FUNCTION {TPanel.}PaneToScroll(VAR anLRect: LRect; hMinToSee, vMinToSee: INTEGER): TPane; 
001330 VAR tempLRect: LRect; 

001331 pane: TPane; 

001332 dummy Pt: Point; 

001333 BEGIN 

001334 {$1 FC fTrace}BP(5); {$ENDC} 

001335 WITH anLRect DO 

001336 BEGIN 

001337 tempLRect.top := top + vMinToSee 

001338 tempLRect.bottom:= bottom ~- vMinToSee 
001339 tempLRect.left := left + hMinToSee 
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001340 
001341 
001342 
001343 
001344 
001345 
001346 
001347 
001348 
001349 
001350 
001351 
001352 
001353 
001354 
001355 
001356 
001357 
001358 
001359 
001360 
001361 
001362 
001363 
001364 
001365 
001366 
001367 
001368 
001369 
001370 
001371 
001372 
001373 
001374 
001375 
001376 
001377 
001378 
001379 
001380 
001381 
001382 
001383 
001384 
001385 
001386 
001387 
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tempLRect.right := right - hMinToSee 
END; 


pane := SELF. PaneShowi ng(tempLRect); 


IF pane = NIL THEN 
BEGIN 
pane := SELF. PaneShowi ng(anLRect); 


IF pane = NIL THEN 
WITH SELF. | astClick DO 
BEGI N 
IF NOT gotPane THEN 
BEGIN 
{$H-} 


clickPane := TPane(SELF.ChildWthPt(clickPt, SELF. panes, dummyPt)); 


{$H+} 
gotPane := TRUE; 
END; 
pane := clickPane; 
END; 
END 
ELSE 
pane := NIL; {already showing The Right Stuff} 


PaneToScroll := pane; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sCldl nit} 
PROCEDURE {TPanel.}Preview{(newMode: TPrevi ewMode) }: 
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VAR ol dMode: TPrevi ewMode: 
showMar gins: BOOLEAN 
hi deMar gins: BOOLEAN 
noSel ection: TSel ection: 
paginatedVi ew: TPagi natedVi ew 
vhs: VHSel ect; 
offset LPoint; 
bs: TListScanner; 
band: TBand; 
firstPane: TPane: 
pagiLPoi nt: LPoi nt; 
ps: TListScanner: 
pane: TPane; 
pageEdit View: TVi ew 
unPagLPt: LPoi nt; {and pageLocation out! } 
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001388 
001389 
001390 
001391 
001392 
001393 
001394 
001395 
001396 
001397 
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001405 
001406 
001407 
001408 
001409 
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001414 
001415 
001416 
001417 
001418 
001419 
001420 
001421 
001422 
001423 
001424 
001425 
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PROCEDURE Xor Breaks OnThePad 
BEGIN 

SELF. view. printManager. DrawBreaks( FALSE); 
END; 


PROCEDURE ClearSel ection; 
BEGIN 

noSelection := SELF.selection,. FreedAndRepl acedBy( SELF. vi ew. NoSel 
END; 


BEGIN 
{$1 FC fTrace}BP(9); {$ENDC} 


ection); 


IF SELF.view.isPrintable THEN {Actually shouldn't be called unless isPrintable} 


BEGIN 
oldMode := SELF. previ ewMode 


showMargins := (newMode = mPrvwMargins); 
hideMargins := (oldMode = mPrvwMargins) 
1F oldMode = newMode THEN 
BEGIN 
END 
ELSE 
IF showMargins OR hideMargins THEN 
BEGIN 


paginatedView := SELF. paginatedVi ew 


1F showMargins THEN 
BEGIN 


paginatedView := SELF. view. printManager. NewPagi natedVi ew( NIL); 


SELF. current View := paginatedVi ew 
SELF. pagi natedView := paginatedView 
END 


ELSE 


SELF.currentView := SELF.view; { newMode = show Breaks or show main view } 


SELF. previewMode := newMode 


FOR vhs := v TO h DO 
BEGIN 
offset. vh[orthogonal[vhs]] := 0; 
bs := SELF. bands[ vhs]. Scanner 
WHILE bs. Scan(band) DO 
BEGIN 
firstPane := TPane( band, panes. First); 
1F showMargins THEN 
paginatedView. PagifyLPoint(first Pane. vi ewedLRect 
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001436 ELSE 

001437 1F hideMargins THEN 

001438 paginatedView. DePagifyLPoint(firstPane. viewedLRect.topLeft, pagiLPoi nt) 
001439 

001440 offset. vh[vhs] := pagiLPoint.vh[vhs] - firstPane. viewedLRect.topLeft.vh[ vhs] 
001441 ps := band, panes. Scanner 

001442 WHILE ps.Scan(pane) DO 

001443 BEGIN 

001444 pane. currentView := SELF. currentView 

001445 pane. Offset By(offset); 

001446 END; 

001447 END; 

001448 END; 

001449 

001450 1F hideMargins THEN 

001451 BEGIN 

001452 pagi natedView. Free 

001453 SELF. paginatedView := NIL; 

001454 theMarginPad. view := NIL; 

001455 END; 

001456 

001457 SELF.Rescroll; {Does Invalidate and Moves Thumbs} 

001458 END 

001459 ELSE 

001460 BEGIN 

001461 SELF. window. Update( TRUE); {Update in the old mode, in case regions were invalid} 
001462 SELF. previewMode := newMode; {Set the new mode} 

001463 SELF. OnAl | Pads Do( Xor Breaks OnThePad) ; {Xor the page breaks} 
001464 END; 

001465 END; 

001466 {$I1FC fTrace}EP; {$ENDC} 

001467 END; 

001468 {$S SgABCres} 

001469 

001470 

001471 {$S SgABCpri } 

001472 PROCEDURE {TPanel. }PrintView{(printPref: TPrReserve) }; 

001473 BEGIN 

001474 {$I1FC fTrace}BP(7); {$ENDC} 

001475 IF SELF.view. printManager <> NIL THEN 

001476 SELF. view. print Manager. Print(printPref); 

001477 {$I1FC fTrace}EP; {$ENDC} 

001478 END; 

001479 {$S SgABCres} 

001480 

001481 

001482 {$8 sStartup} 

001483 PROCEDURE {TPanel.}Refresh{(rActions: TActions; highTransit: THighTransit) }; 
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PROCEDURE RefreshPane(obj: TObj ect); 
VAR pane: TPane; 
BEGIN 
pane := TPane(obj); 
IF RectisVisible(pane.outerRect) THEN 
pane. Refresh(rActions, highTransit); 


END; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
{$IFC f DbgABC} 
IF (rBackground IN rActions) AND (highTransit > hOffToOn) THEN 
ABCBreak('Refresh: rBackground requested, but highTransit does not start from Off', 0); 
{$ENDC} 
[F rFrame IN rActions THEN 
SELF. Frame; 


SELF. panes. Each( Ref reshPane) ; 
{$1FC fTrace}EP; {$ENDC} 

END; 

SgABCres} 


{$S SgABCcl d} 
PROCEDURE {TPanel. }RemakePanes; 
VAR vs, ps: TListScanner 
band: TBand; 
pane: TPane; 
BEGIN 
{assumes they are right in the bands} 
{$I1FC fTrace}BP(7); {$ENDC} 
SELF. panes. Del All ( FALSE); 
vs := SELF. bands[v]. Scanner 
WHILE vs. Scan(band) DO 
BEGIN 
ps := band, panes, Scanner 
WHILE ps.Scan(pane) DO 
SELF. panes. insLast( pane); 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCcl d} 

PROCEDURE {TPanel.}RememberSplit{(vhs: VHSelect; atCd: INTEGER) }; 
VAR deletedSplits: TArray 

BEGIN 
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{$I1FC fTrace}BP(7); {$ENDC} 
deletedSplits := SELF. deletedSplits 
IF deletedSplits <> NIL THEN 
BEGIN 
{$1 FC fDbgABC} 
IF deletedSplits.recordBytes <> 2 THEN 
ABCbreak('This panel has a deletedSplits array, but its recordBytes <> 2', ORD(SELF)); 
{$ENDC} 


IF vhs = v THEN 
atCd := - atCd 
deletedSplits. InsLast(@atCd); 
END; 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$8 SgABCcl d} 
PROCEDURE {TPanel.}Remove 


VAR itsParent: TBranchArea 
itsGrandParent: TBranchArea; 
itsSibling: TArea; 
itsWindow: TWi ndow; 
firstPanel: TPanel: 

BEGIN 


{$I FC fTrace}BP(7); {$ENDC} 
itsParent := SELF. parentBranch; 
itsWindow := SELF. window 


{$1 FC fDbgABC} 
IF itsParent = NIL THEN 

ABCBreak('You cannot remove the last panel in the window’, ORD(SELF)); 
{$ENDC} 


itsGrandParent := itsParent. parent Branch; 
itsSibling := itsParent. OtherChild( SELF); 


itsSibling. Resi zeOutside(itsParent. outerRect); 


itsSibling. parentBranch := itsGrandParent; 
IF itsGrandParent = NIL THEN 

itsWndow. panel Tree := itsSibling 
ELSE 


itsGrandParent. ReplaceChild(itsParent, itsSibling); {also sets my parentBranch to NIL} 


SELF.resizeBranch := NIL; 
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001580 firstPanel := TPanel(itsWindow. panels. First); 
001581 IF itsWindow.selectPanel = SELF THEN 

001582 itsWndow.selectPanel := first Panel 
001583 IF itsWindow.clickPanel = SELF THEN 

001584 itsWndow.clickPanel := firstPanel 
001585 {We do not change undoSel Panel & undoClickPanel because undo may bring them back; so caller beware! } 
001586 itsParent. Free: 

001587 

001588 itsWindow. panels. Del Obj ect(SELF, FALSE) 
001589 {$I1FC fTrace}EP; {$ENDC} 

001590 END; 

001591 {$S SgABCres} 

001592 

001593 

001594 {$S SgABCcl d} 

001595 PROCEDURE {TPanel. }RepaneOrthogonal Bands{(vhs: VHSel ect) }; 
001596 VAR bs, orthoBs, ps: TListScanner 

001597 orthoBands: TList; 

001598 band, oBand: TBand 

001599 pane: TPane; 

001600 BEGIN 

001601 {assumes they are right in the orthogonal band} 
001602 {$I1FC fTrace}BP(7); {$ENDC} 

001603 orthoBands := SELF. bands[ orthogonal [vhs] ] 
001604 orthoBs := orthoBands. Scanner 

001605 while orthoBs.Scan(oBand) do 

001606 oBand. panes. Del All ( FALSE) 

001607 bs := SELF. bands[ vhs]. Scanner 

001608 WHILE bs.Scan(band) DO 

001609 BEGIN 

001610 ps := band, panes. Scanner 

001611 orthoBs := orthoBands. Scanner 

001612 WHILE ps.Scan(pane) AND orthoBs.Scan(oBand) DO 
001613 oBand. panes. insLast( pane) 

001614 END; 

001615 {$I1FC fTrace}EP; {$ENDC} 

001616 END; 

001617 {$S SgABCres} 

001618 

001619 

001620 {$S SgABCcl d} 

001621 PROCEDURE {TPanel.}Replace{( panel: TPanel)}; 
001622 VAR itsParent: TBranchArea 

001623 its Window: TWi ndow 

001624 BEGIN 

001625 {$IFC fTrace}BP(7); {$ENDC} 

001626 itsParent := SELF. parent Branch; 

001627 itsWindow := SELF. window 
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001628 

001629 itsWindow. panels. Del Obj ect(SELF, FALSE); 

001630 itsWindow. panels. I nsLast(panel); 

001631 

001632 IF itsParent = NIL THEN 

001633 itsWindow. panel Tree := pane 

001634 ELSE 

001635 itsParent.ReplaceChild(SELF, panel); {also sets my parentBranch to NIL} 
001636 

001637 SELF.resizeBranch := NIL; 

001638 

001639 panel. Resi zeOQutsi de(SELF. outerRect); 

001640 

001641 IF itsWindow.selectPanel = SELF THEN 

001642 itsWndow.selectPanel := panel 

001643 IF itsWindow.clickPanel = SELF THEN 

001644 itsWndow.clickPanel := panel 

001645 {We do not change undoSel Panel & undoClickPanel because undo may bring them back; so caller beware! } 
001646 {$1FC fTrace}EP; {$ENDC} 

001647 END; 

001648 {$S SgABCres} 

001649 

001650 

001651 {$$ sCldil nit} 

001652 PROCEDURE {TPanel. }Rescroll 

001653 VAR vhs: VHSel ect 

001654 band: TBand 

001655 S! TListScanner; 

001656 BEGIN 

001657 {$I1FC fTrace}BP(7); {$ENDC} 

001658 Inval Rect(SELF.outerRect); {Since the viewis changing, no part of the old image is good} 
001659 FOR vhs := v TO h DO 

001660 BEGIN 

001661 s := SELF. bands[vhs]. Scanner; 

001662 WHILE s.Scan(band) DO 

001663 IF band.scroller <> NIL THEN 

001664 Set Thumb( POI NTER( band. scroller. sBoxlD), band. ThumbPos) 

001665 {since we invalidated everything, just telling the SB library where the 
001666 thumb should be is enough} 

001667 END; 

001668 {$I1FC fTrace}EP; {$ENDC} 

001669 END; 

001670 {$S SgABCres} 

001671 

001672 

001673 {$S SgABCcl d} 

001674 PROCEDURE {TPanel.}ResizeBand{(vhs: VHSelect; band: TBand; newViewLCd: LONGI NT 
001675 flnvalidate: BOOLEAN) }: 
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BEGIN 


VAR scroller: TScroller 
sbRect: Rect; 
tempRect: Rect; 
toBeDel eted: TList {OF TPane}; 
ps: TListScanner; 
pane: TPane; 
ol dBandl nner: Rect; 
newOuterRect: Rect; 
unchangedRect: Rect; 
tempBand: TBand; 
sideBand: TSi deBand 

{$IFC fTrace}BP(7); {$ENDC} 

scroller := band.scroller 

IF scroller = NIL THEN {band is a side band} 
sbRect := band. outerRect 

ELSE 
BEGIN 


scroller. GetSize(sbRect); 
WITH sbRect DO {regular bands must lie within the contentRect; the +/- 1 is 
because the contentRect corresponds to the innerRect, but 
sbRect must be based on the outerRect} 
BEGIN 
topLeft.vh[vhs] := Max(topLeft.vh[ vhs], SELF.contentRect.topLeft.vh[vhs] - 1); 
botRight.vh[vhs] := Min(botRight.vh[vhs], SELF.contentRect.botRight.vh[vhs] + 1); 


END; 
END; 
unchangedRect := zeroRect; 
IF LengthRect(sbRect, vhs) <= 0 THEN 
BEGIN 
toBeDeleted := TList.CREATE(NIL, SELF.Heap, band. panes. size) 
ps := band, panes, Scanner 


WHILE ps.Scan(pane) DO 
toBeDel eted. I nsLast( pane) 

SELF. bands[vhs].Del Obj ect( band, TRUE); 

SELF. Cl eanUpPanes(toBeDel et ed); 

END 

ELSE 

BEGIN 

newOuterRect := SELF.innerRect; 

InsetRect(newOuterRect, -1, -1); 

AlignRect(newOuterRect, sbRect, vhs); 

ol dBandI nner := band.innerRect; 

band. Set OuterRect(newOuterRect); 

band. Resi zePanes( newVi ewLCd); 
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001724 

001725 IF flnvalidate THEN 

001726 1F band. ViewLCd = newViewLCd THEN 

001727 IF SectRect(oldBandinner, band.innerRect, unchangedRect) THEN; 
001728 END; 

001729 

001730 IF flnvalidate THEN 

001731 Inval DiffRect(band. outerRect, unchangedRect); 
001732 {$I1FC fTrace}EP; {$ENDC} 

001733 END; 

001734 

001735 

001736 {$$ sCldl nit} 

001737 PROCEDURE {TPanel.}Resizel nside{(newlnnerRect: Rect) }; 
001738 VAR toBeDel eted: TList {OF TPane}; 

001739 all BandOuterRect: Rect; 

001740 vhs: VHSel ect; 

001741 S! TListScanner; 

001742 nextTopLeft: INTEGER 

001743 last BotRi ght: INTEGER 

001744 thi sBot Ri ght: INTEGER 

001745 band: TBand; 

001746 ps: TListScanner; 

001747 pane: TPane; 

001748 newBandOuterRect: Rect; 

001749 ol dVi ewLCd: LONGI NT; 

001750 firstBand: TBand; 

001751 lastBand: TBand; 

001752 BEGIN 

001753 {$I1FC fTrace}BP(7); {$ENDC} 

001754 toBeDeleted := TList. CREATE(NIL, SELF.Heap, 0) 
001755 all BandOuterRect := newlnnerRect 

001756 InsetRect(allBandOuterRect, -1, -1) 

001757 FOR vhs := v TO h DO 

001758 BEGIN 

001759 firstBand := TBand( SELF. bands[vhs]. First); 
001760 IF firstBand.scroller = NIL THEN 

001761 firstBand := TSideBand(firstBand). CoBand 
001762 lastBand := TBand(SELF. bands[vhs].Last); 
001763 IF lastBand.scroller = NIL THEN 

001764 lastBand := TSideBand(last Band). CoBand 
001765 

001766 {$H- } 

001767 WITH SELF.contentRect DO 

001768 BEGIN 

001769 nextTopLeft := Max(topLeft.vh[vhs]-1, all BandOuterRect.topLeft.vh[vhs]); 
001770 lastBotRight := Min(botRight.vh[vhs]+1, all BandOuterRect. bot Right. vh[vhs]); 
001771 END; 
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{$H+} 


s := SELF. bands[vhs]. Scanner; 
WHILE s.Scan(band) DO 
IF band.scroller = NIL THEN {a side band} 
BEGIN 
1F NOT TSideBand(band).topOrLeft THEN {a bottom/right side band must be moved 
into a new position} 
BEGIN 
SELF. SideBandRect(vhs, FALSE, newBandOuterRect); {.SideBandRect returns an I nnerRect } 
InsetRect(newBandOuterRect, -1, -1); {outerRect is innerRect outset by 1...} 
WITH newBandOuterRect.topLeft DO 
vh[ vhs] := vh[ vhs] + 1; {... EXCEPT on the top/left} 


band. Resi zeOutside(newBandOuter Rect); 
END; 
END 
ELSE {a regular band} 
{Always leave at least one pane} 
IF (band <> firstBand) AND (nextTopLeft >= |astBotRight) THEN 
BEGIN 
ps := band, panes, Scanner 
WHILE ps.Scan(pane) DO 
|F toBeDeleted. Pos(0, pane) <= 0 THEN 
toBeDel eted. I nsLast( pane); 
SELF. RememberSplit(vhs, band. outerRect.topLeft.vh[vhs]); 
s. Del ete( TRUE); 
END 
ELSE 
BEGIN 
newBandOuterRect.topLeft.vh[vhs] := nextTopLeft; 
1F band = lastBand THEN 
thisBotRight := | astBotRi ght 
ELSE 
thisBotRight := Min(nextTopLeft + lengthRect(band. outerRect, vhs), |astBotRight); 
newBandOuterRect. bot Right. vh[vhs] := thisBotRi ght; 
Ali gnRect(newBandOuterRect, all BandOuterRect, orthogonal [vhs]); 
ol dViewLCd := band. Vi ewLCd 
band. Resi zeOutside(newBandOuter Rect); 
IF oldViewLCd <> band. ViewLCd THEN 
Inval Rect(band.innerRect); 
nextTopLeft := newBandOuterRect. bot Ri ght. vh[ vhs] 
END; 
END; 
SELF. Cl eanUpPanes(toBeDel et ed); 
SELF.RestoreSplits; {do this after all the bands have been adj usted} 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$S SgABCres} 


{$S SgABCcl d} 
PROCEDURE {TPanel.}ResizeOutside{(newOuterRect: Rect)}; 
VAR ol dOuterRect: Rect; 
oldinnerRect: Rect; 
newlnnerRect: Rect; 
unchangedRect: Rect; 


BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
oldQuterRect := SELF. outerRect; 


1F NOT Equal Rect(oldOuterRect, newOuterRect) THEN 


BEGIN 

oldinnerRect := SELF.innerRect; 
SELF. Deci deAbout Bars( newOuterRect); 
newlnnerRect := SELF.innerRect; 
unchangedRect := zeroRect; 


1F Equal Pt(oldOuterRect.topLeft, newOuterRect.topLeft) THEN 
IF SectRect(oldinnerRect, newlnnerRect, unchangedRect) THEN; 


Inval DiffRect(newOuterRect, unchangedRect); 
SELF. Resi zel nside(newlnnerRect); 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sCldil nit} 
PROCEDURE {TPanel.}RestoreSplits 
VAR deletedSplits: TArray 
content Rect: Rect; 
vhs: VHSel ect; 
firstScrollers: ARRAY[VHSelect] OF TScroller 
S: TArrayScanner; 
pl nt: Ptr; 
cd: INTEGER; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
deletedSplits := SELF. deletedSplits 


IF deletedSplits <> NIL THEN 
BEGIN 
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001868 {$1 FC fDbgABC} 

001869 IF deletedSplits.recordBytes <> 2 THEN 

001870 ABCbreak('This panel has a deletedSplits array, but its recordBytes <> 2', ORD(SELF)) 
001871 {$ENDC} 

001872 

001873 contentRect := SELF. contentRect; 

001874 FOR vhs := v TO h DO 

001875 firstScrollers[vhs] := SELF.scroll Bars[vhs].firstBox; 

001876 

001877 s := deletedSplits. Scanner 

001878 WHILE s.Scan(plnt) DO 

001879 BEGIN 

001880 cd := Tplnteger( pint) * 

001881 

001882 1F cd < 0 THEN 

001883 BEGIN 

001884 vhs := V3 

001885 cd :=- cd: 

001886 END 

001887 ELSE 

001888 vhs := h} 

001889 

001890 IF (cd > contentRect.topLeft.vh[vhs]) AND 

001891 (cd < contentRect. botRight.vh[ vhs] - dptSkewer.vh[vhs]) THEN 
001892 BEGIN 

001893 SELF. MoveSplitBefore(firstScrollers[vhs], cd); 

001894 s. Delete: 

001895 END; 

001896 END; 

001897 END; 

001898 {$I1FC fTrace}EP; {$ENDC} 

001899 END; 

001900 {$S SgABCres} 

001901 

001902 

001903 {$$ sRes} 

001904 PROCEDURE {TPanel.}Reveal LRect(VAR anLRect: LRect; hMinToSee, vMinToSee: INTEGER); 
001905 VAR pane: TPane 

001906 revisedLRect: LRect; 

001907 BEGIN 

001908 {$1 FC fTrace}BP(5); {$ENDC} 

001909 [F SELF. previewMode = mPrvwMargins THEN {need to map coords} 

001910 BEGIN 

001911 SELF. paginatedView. PagifyLPt(anLRect.topLeft, revisedLRect.topLeft); 
001912 SELF. paginatedView. PagifyLPt(anLRect. botRight, revisedLRect. botRi ght); 
001913 END 

001914 ELSE 

001915 revisedLRect := anLRect; 
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pane := SELF. PaneToScroll(revisedLRect, hMinToSee, vMinToSee); 
1F pane <> NIL THEN 
pane. Scroll ToReveal(revisedLRect, hMinToSee, vMinToSee); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TPanel.}Seti nnerRect{(newl nnerRect: Rect) }; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
SUPERSELF. Seti nner Rect (newl nnerRect); 
SELF. ComputeContent Rect; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TPanel.}SetOuterRect{(newOuterRect: Rect) }; 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
SUPERSELF. Set Outer Rect (newOuterRect); 
SELF. Comput eContent Rect; 
{$I1FC fTrace}EP; {$ENDC} 
END: 


{$S SgABCcl d} 

PROCEDURE {TPanel.}SetZoomFactor{(zoomNumerator, zoomDenomi nator: Point) }; 
VAR s: TListScanner 

pane: TPane; 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
Reduce(zoomNumerator.h, zoomDenominator.h); {reduce to lowest terms} 
Reduce(zoomNumerator.v, zoomDenominator.v); {reduce to lowest terms} 
{$1 FC fDbgABC} 
1F fExperi menting THEN 


WriteLn('New (h) Zoom: ', zoomNumerator.h:1, '/', zoomDenomi nator. h: 1) 
{$ENDC} 
WTH SELF, zoomFactor DO 
BEGIN 
numerator := zoomNumerator 
denominator := zoomDenomi nator 
zoomed := (numerator.h <> denominator. h) OR (numerator.v <> denominator. v) 
END; 
s := SELF. panes. Scanner 


WHILE s.Scan(pane) DO 
pane, Set ZoomFactor(zoomNumerator, zoomDenomi nator) 
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{$1FC fTrace}EP; {$ENDC} 


END; 


{$S SgABCres} 


{$$ SgABCcl d} 


PROCEDURE {TPanel. }ShowSi deBand{( vhs: 


VAR x 


bandl ndex: 
band: 
content Rect: 


tempRect: 


ol dSi deSi ze: 
newVi ewLCd: 


scroller: 


$: 


bandVHS: 


bandl sCovered: 
moveNextSplit: 


removeCd: 


Cc 


BEGIN 


oBand: 


INTEGER; 
INTEGER; 
TBand; 
Rect; 
Rect; 
INTEGER; 
LONGI NT; 
TScroller; 
TListScanner; 
VHSel ect; 
BOOLEAN; 
BOOLEAN; 
INTEGER; 
TBand; 


{$I FC fTrace}BP( 12); {$ENDC} 
SELF. SideBandRect(vhs, topOrLeft, tempRect); 


ol dSi 
X is 


WITH SELF DO 


deSize 
Max(-1, 


size); 


IF topOrLeft THEN 


tl SideBandSize.vh[vhs] : 


LSE 


brSideBandSize.vh[vhs] := 


SELF. Comput eContent Rect; 


IF size > oldSideSize THEN 
BEGIN 


SELF. wi ndow. Resize( FALSE) 


{Does Invalidate and Moves Thumbs} 


VHSelect; topOrLeft: BOOLEAN; size: 


:= LengthRect(tempRect, vhs); 


xX; 


{ delete splits that are now covered by the bigger side band } 
IF topOrLeft THEN 


moveNextSplit 


removeCd 


LSE 


removeCd 


0 


MAXI NT; 


:= FALSE; 
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INTEGER; viewLCd: 


{make sure we have enough space for the bigger side band} 
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s := SELF. bands[vhs]. Scanner; 


WHILE s.Scan(band) DO 
IF band.scroller <> NIL THEN {not a side band} 
BEGIN 
bandisCovered := NOT SectRect(band.innerRect, SELF.contentRect, tempRect); 


IF bandlsCovered THEN 
s.Delete(FALSE); {delete it fromthe list before some other method, so our scanner 
doesn't get confused; it will still get freed later, though} 


IF moveNextSplit OR (bandisConvered AND NOT topOrLeft) THEN 
BEGIN 
SELF. RememberSplit(vhs, band. outerRect.topLeft.vh[vhs]); 
SELF. MoveSplitBefore(band.scroller, removeCd); 
END; 


moveNextSplit := bandlsCovered AND topOrLeft; 
END; 


END; 
SELF. SideBandRect(vhs, topOrLeft, tempRect); 


{Create/Resize/ Delete the sideBand} 

IF (oldSideSize = -1) AND (size >= 0) THEN {create} 
BEGIN 
band := TSideBand. CREATE(NIL, SELF.Heap, SELF, tempRect, vhs, topOrLeft, viewLCd); 
coBand := TSideBand( band). Coband 


Inval Rect(tempRect); 


SELF. RepaneOrt hogonal Bands( vhs); 
SELF. RemakePanes; 


{calculate the new viewLCd for the side band's coBand} 
newVi ewLCd : = coBand. Vi ewLCd; 
IF topOrLeft THEN 
newViewLCd := newViewLCd + size + 1; 
END 
ELSE IF oldSideSize >= 0 THEN 
BEGIN 
IF topOrLeft THEN {get the side band to resize into band} 
band := TBand( SELF. bands[vhs]. First) 
ELSE 
band := TBand( SELF. bands[vhs].Last); 
coband := TSideBand( band). Coband 


band. Seti nnerRect(tempRect); {side bands are resized according to their current inner/outerRects} 
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SELF. ResizeBand(vhs, band, band. ViewLCd, TRUE) 


{calculate the new viewLCd for the side band's coBand} 
newVi ewLCd : = coBand. Vi ewLCd; 
IF topOrLeft THEN 
newVi ewLCd := newViewLCd + size - oldSideSize 
END 
ELSE 
coBand := NIL; 


1F coBand <> NIL THEN 
BEGIN 
{resize the regular band that is next to the sideBand (coband) } 
SELF. ResizeBand(vhs, coBand, newViewLCd, TRUE) 


{invalidate the scroller associated with coBand} 
coBand. scroller. GetSize(tempRect); 
Inval Rect(tempRect); 


SELF. RestoreSplits 
END; 
{$I1FC fTrace}EP; {$ENDC} 


END; 
{$$ SgABCres} 


{$8 SgABCcl d} 
PROCEDURE {TPanel.}SideBandRect{(vhs: VHSelect; topOrLeft: BOOLEAN; VAR bandRect: Rect) }; 
{gets the innerRect of a side band, given the current contentRect} 
VAR content Rect: Rect; 
BEGIN 
bandRect := SELF.innerRect 
WITH bandRect DO 
IF topOrLeft THEN 
botRight.vh[vhs] := toplLeft.vh[vhs] + SELF. tI SideBandSi ze. vh[ vhs] 
ELSE 
topLeft.vh[vhs] := botRight.vh[vhs] - SELF. brSideBandSi ze. vh[ vhs] 
END: 


{$S SgABCi ni } 
END; 
{$$ SgABCres} 


METHODS OF TBand; 
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{$5 sCldl nit} 
FUNCTI ON 


VAR panes: TList; 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 


object := NewObject(heap, THISCLASS) 
SELF := TBand(obj ect); 
WITH SELF DO 
BEGIN 
window := itsPanel. window 
panel := itsPanel 
scroller := itsScroller 
scroll Dir := itsDir; 
parentBranch := NIL; 
END; 
panes := TList.CREATE(NIL, heap, 1); 


SELF. panes := panes; 
SELF. Seti nnerRect(itsI nnerRect); 
IF itsScroller <> NIL THEN 
itsScroller. band := SELF; 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCi ni } 
PROCEDURE {TBand. }Free; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
Free(SELF. scroller); 
SELF. panes. FreeObj ect; 
TArea. Free; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$1 FC fDebugMet hods} 
{$S SgABCdbg} 
PROCEDURE {TBand. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 
TArea. Fields( Field); 
Field(' window: TWindow'); 
Field(' panes: TList'); 
Field('panel: TPanel') 
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{TBand. }CREATE{(object: TObject; heap: THeap; itsPanel 
itsScroller: TScroller; itsDir: VHSelect): 


TPanel; itsIlnnerRect: Rect; 
TBand}: 
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Field('scroller: TScroller') 
Field('scrollDir: Byte') 
Field(''); 

END; 

{$S SgABCres} 

{$ENDC} 


{$$ sScroll } 
PROCEDURE {TBand. }OffsetPanes{(deltaLPt: LPoint)}; 


PROCEDURE YouOffset(obj: TObj ect); 
BEGIN 

TPane( obj). Offset By(deltaLPt); 
END; 


BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
SELF. panes. Each( YouOffset); 
{$I1FC fTrace}EP; {$ENDC} 


END; 
{$$ sCldl nit} 
PROCEDURE {TBand. }Resi zeOutside{(newOuterRect: Rect) }; 
VAR scroller: TScroller 
newScrollerSize: Rect; 
unchangedRect: Rect; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF NOT Equal Rect(SELF.outerRect, newOuterRect) THEN 


BEGIN 

unchangedRect := SELF.outerRect; 

IF NOT Equal Pt(unchangedRect.topLeft, newOuterRect.topLeft) THEN 
unchangedRect := zeroRect 

ELS 


InsetRect(unchangedRect, 1, 1); {we want unchangedRect to be the old innerRect} 


Inval Diff Rect(newOuterRect, unchangedRect); 


scroller := SELF.scroller 
SELF. Set OuterRect(newOuterRect); 


newScrollerSize := SELF. outerRect; 
WITH SELF DO 
BEGIN 
newScrollerSize. botRight.vh[orthogonal[scrollDir]] := 
panel.innerRect. botRight.vh[orthogonal[scrollDir]] + 1; 
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002204 IF innerRect.topLeft.vh[scrollDir] = panel. contentRect.topLeft.vh[scroll Dir] THEN 
002205 newScrollerSize.topLeft.vh[scroll Dir] := panel.innerRect.topLeft.vh[scrollDir] - 1; 
002206 

002207 IF innerRect. botRight.vh[scrollDir] = panel.contentRect. botRight.vh[scroll Dir] THEN 
002208 newScrollerSize. botRight.vh[scroll Dir] := panel.innerRect. botRight.vh[scroll Dir] + 1; 
002209 END; 

002210 scroller, SetSize(newScrollerSi ze) 

002211 

002212 SELF. Resi zePanes( SELF. Vi ewLCd) 

002213 END; 

002214 {$I1FC fTrace}EP; {$ENDC} 

002215 END; 

002216 {$S SgABCres} 

002217 

002218 

002219 {$$ sCldil nit} 

002220 PROCEDURE {TBand. }ResizePanes{(newViewLCd: LONGI NT) }; 

002221 {assumes SELF.innerRect already set} 

002222 VAR vhs: VHSel ect; 

002223 S! TListScanner; 

002224 pane: TPane; 

002225 vi ewedLRect: LRect 

002226 scrollableLRect: LRect; 

002227 ol dVi ewLCd: LONGI NT; 

002228 deltaLPt: LPoint; 

002229 BEGIN 

002230 {$I1FC fTrace}BP(7); {$ENDC} 

002231 vhs := SELF.scroll Dir; 

002232 

002233 s := SELF. panes. Scanner 

002234 WHILE s.Scan(pane) DO 

002235 pane, Resize(SELF.innerRect, vhs); 

002236 

002237 [F SELF.panel.currentView <> NIL THEN 

002238 BEGIN 

002239 pane := TPane( SELF. panes. First); 

002240 pane, GetScrollLimits(viewedLRect, scrollableLRect); 

002241 ol dViewLCd := SELF. ViewLCd 

002242 newViewLCd := Max(scrollableLRect.topLeft.vh[vhs] 

002243 Min(scrollableLRect. botRight.vh[vhs] - LengthLRect(viewedLRect, vhs), 
002244 newVi ewLCd)); 

002245 

002246 deltaLPt.vh[orthogonal[vhs]] := 0; 

002247 {$H-} deltaLPt.vh[vhs] := newViewLCd - oldViewlLCd; {$H+} 

002248 SELF. Offset Panes(deltaLPt) 

002249 SELF. Scroll By(0); 

002250 Set Thumb( POI NTER(SELF.scroller.sBoxlD), SELF. ThumbPos); 

002251 {need to set thumb because band changed size} 
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END; 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sScroll} 
PROCEDURE {TBand. }Scrol|By{(deltaLCd: LONGI NT) }; 
{positive scrolls towards end; 0 means resize & don't move thumb} 
VAR deltaLPt: LPoint; 
vhs: VHSel ect; 
BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
PushFocus; 
SELF. wi ndow. Focus 


WITH SELF, deltaLPt DO 

BEGIN 

vhs := scroll Dir; 

vh[ vhs] := deltaLCd 
vh[orthogonal[vhs]] := 0; 
E 1 


SELF. panel. DoScrolling(SELF, TPane(SELF. panes. First), vhs=h, vhs=v, deltaLPt) 


1F NOT EqualLPt(deltaLPt, zeroLPt) THEN 
SELF. Offset Panes(deltaLPt); 


IF deltaLCd <> 0 THEN 
IF SELF.scroller <> NIL THEN {can this be a side band???} 
SELF.scroller. MoveThumb( SELF. ThumbPos); 


PopFocus; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sScroll} 
PROCEDURE {TBand. }ScrollStep{(icon: TEnumlcons; deltaLStd: LONGI NT) }; 
VAR vhs: VHSel ect; 
len: LONGI NT; 
deltaLCd: LONGI NT; 
BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
vhs := SELF. scroll Dir; 
len: 


screenRes.vh[vhs]); 
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CASE icon OF {how far to scroll without regard for overshooting the ends} 


i Scroll Back: 

deltaLCd := -deltaLStd 
i Scroll Fwd: 

deltaLCd := deltaLStd 
i Fl i pBack: 

deltaLCd := Min(deltaLStd - len, -deltaLStd) 
i Fl i pFwd: 

deltaLCd := Max(len - deltaLStd, deltaLStd) 
END; 


SELF. Scroll By(deltaLCd); 
{$I1FC fTrace}EP; {$ENDC} 


END; 
{$$ sScroll} 
PROCEDURE {TBand. }Scrol!lTo{(viewLCd: LONGI NT) }; 
VAR pane: TPane; 
deltaLCd: LONGI NT; 
BEGIN 


{$1FC fTrace}BP( 6); {$ENDC} 

pane := TPane(SELF. panes. First); 

deltaLCd := viewLCd - pane. viewedLRect.topLeft.vh[ SELF. scroll Dir] 
SELF. Scroll By(deltaLCd); 

{$I1FC fTrace}EP; {$ENDC} 


END: 

{$$ sScroll } 

FUNCTION {TBand. }ThumbPos{: | NTEGER}; 

VAR vhs: VHSel ect; 

pane: TPane; 
vi ewedLRect: LRect; 
scrollabl eLRect: LRect; 
t humbL Range: LONGI NT; 
bar Range: INTEGER; 
1 Offset: LONGI NT; 
barPos: INTEGER; 

BEGIN 


{$I1FC fTrace}BP( 4); {$ENDC} 

vhs := SELF.scroll Dir; 

pane := TPane(SELF. panes. First); 

pane, GetScrollLimits(viewedLRect, scrollableLRect); 

thumbLRange := LengthLRect(scrollableLRect, vhs) - LengthLRect(viewedLRect, vhs) 
barRange := SELF.scroller. ThumbRange 


IF barRange = 0 THEN 
ThumbPos := 0 
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{$$ 
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ELSE 
BEGIN 
l0ffset := viewedLRect.topLeft.vh[vhs] - scrollableLRect.topLeft. vh[ vhs] 


IF thumbLRange > 1 THEN {Only divide by positive denominators} 
barPos := LintDivLint(LintMullnt(lOffset, barRange - 1) + thumbLRange - barRange 
thumbLRange - 1) 


ELSE 
IF (thumbLRange = 1) AND (lOffset > 0) THEN {Very rare case: view one pixel bigger 
than pane... } 
barPos := barRange {...and scrolled to end} 
ELS 
barPos := 0; {Usually because the view is smaller than the 
pane} 


{barPos = 0 or barRange only if nowhere to scroll} 


ThumbPos := Max(0, Min(1000, LintDivint(LI nt Mull nt(barPos, 1000) + barRange - 1, barRange))); 


{ThumbPos = 0 or 1000 only if nowhere to scroll [assumes band is <= 1000 pixels long] } 


END; 
{$I1FC fTrace}EP; {$ENDC} 


sScroll } 
PROCEDURE {TBand. }ThumbTo{(newThumbPos: INTEGER) }; 
VAR vhs: VHSel ect; 
thumbL Range: LONGI NT; 
pane: TPane; 
vi ewedLRect: LRect; 
scrollableLRect: LRect; 
N 


BEGI 


END; 


{$$ 


{$IFC fTrace}BP( 6); {$ENDC} 
vhs := SELF. scroll Dir; 
pane := TPane(SELF. panes. First); 
pane, GetScrollLimits(viewedLRect, scrollableLRect); 
thumbLRange := LengthLRect(scrollableLRect, vhs) - LengthLRect(viewedLRect, vhs) 
SELF. Scroll To(scrollableLRect.topLeft.vh[ vhs] + 
Li ntDivint( Lint Mull nt(thumbLRange, newThumbPos), 1000)) 
{$1FC fTrace}EP; {$ENDC} 


sRes} 


FUNCTION {TBand. }ViewLCd{: LONGI NT}; 


BEGI 


VAR pane: TPane 

N 

{$I FC fTrace}BP( 4); {$ENDC} 

pane := TPane(SELF. panes. First); 
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ViewLCd := pane. viewedLRect.topLeft.vh[SELF.scroll Dir] 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$S SgABCi ni } 
END; 
{$$ SgABCres} 


METHODS OF TSideBand: 


{$8 SgABCcl d} 
FUNCTION {TSideBand. }CREATE{(object: TObject; heap: THeap; itsPanel: TPanel; itsInmnerRect: Rect; 
itsDir: VHSelect; itsTopOrLeft: BOOLEAN 
itsViewLCd: LONGINT): TSideBand}; 
VAR bandList: TList; 
itsCoBand: TBand 
deltaLPt: LPoint; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
TSideBand(object).topOrLeft := itsTopOrLeft; {needed to be set before SetinnerRect, which is 
done in TBand. CREATE} 


SELF := TSideBand(TBand. CREATE( object, heap, itsPanel, itsIlnnerRect, NIL, itsDir)) 
bandList := itsPanel. bands[itsDir] 


IF itsTopOrLeft THEN 
BEGIN 
itsCoBand := TBand(bandList. First); 
bandList. I nsFirst( SELF) 
END 
ELSE 
BEGIN 
itsCoBand := TBand(bandList.Last); 
bandList.InsLast( SELF); 
END; 


SELF. panes. Become(itsCoBand. panes. Cl one( heap) ); 
SELF. ResizePanes(itsViewLCd); 
{$I FC fTrace}EP; {$ENDC} 

END; 
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{$S SgABCcl d} 
PROCEDURE {TSideBand. }Free 


BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
SELF.scroller := NIL; {let my coBand free the scroller} 


SUPERSELF. Free; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 

{$S SgABCdbg} 

PROCEDURE {TSideBand. }Fields{(PROCEDURE Field(nameAndType: $255))}; 

BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SUPERSELF. Fields(Field); 
Field('topOrLeft: BOOLEAN'); 
Field(''): 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$ENDC} 


{$S SgABCcl d} 
FUNCTION {TSideBand. }CoBand{: TBand}; 
VAR bandList: TList; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
bandList := SELF. panel. bands[SELF. scroll Dir] 
1F SELF.topOrLeft THEN 
CoBand := TBand(bandList. At(2)) 
ELSE 
CoBand := TBand(bandList. At(bandList. Size-1)); 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$S SgABCcl d} 
PROCEDURE {TSideBand. }GetBorder{(VAR border: Rect) }; 
BEGIN 
{$1 FC fTrace}BP(7); {$ENDC} 
SUPERSELF. Get Border( border); 
WITH SELF, border DO 
IF topOrLeft THEN 
bot Right. vh[scrollDir] := 0 
ELSE 
topLeft.vh[scroll Dir] := 0; 
{$I1FC fTrace}EP; {$ENDC} 
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{$S SgABCcl d} 
PROCEDURE {TSideBand. }ResizeOutside{(newOuterRect: Rect) }; 
VAR unchangedRect: Rect; 
rectTolnval: Rect; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF NOT Equal Rect(SELF.outerRect, newOuterRect) THEN 
BEGIN 
unchangedRect := SELF.outerRect; 
1F NOT Equal Pt(unchangedRect.topLeft, newOuterRect.topLeft) THEN 
unchangedRect := zeroRect 
ELSE 


InsetRect(unchangedRect, 1, 1); {we want unchangedRect to be the old innerRect} 


SELF. Set OuterRect(newOuterRect); 


rectTolnval := SELF.innerRect; 
InsetRect(rectTolnval, -1, -1); 
Inval DiffRect(rectTolnval, unchangedRect); 


SELF. Resi zePanes( SELF. Vi ewLCd); 
END; 

{$SIFC fTrace}EP; {$ENDC} 
END; 


{$S SgABCcl d} 
PROCEDURE {TSideBand. }Resi zePanes{( newViewLCd: LONGI NT) };: 
{assumes SELF.innerRect already set} 


VAR vhs: VHSel ect; 
S! TListScanner: 
pane: TPane; 
vi ewedLRect: LRect; 
scrollabl eLRect: LRect; 
ol dVi ewLCd: LONGI NT; 
deltaLPt: LPoint; 

BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 
vhs := SELF.scroll Dir; 


s := SELF. panes. Scanner 
WHILE s.Scan(pane) DO 
pane. Resize(SELF.innerRect, vhs); 


ol dViewLCd := SELF. ViewLCd: 
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002540 deltaLPt. vh[orthogonal[vhs]] := 0; 

002541 deltaLPt.vh[vhs] := newViewLCd - oldViewLCd 

002542 SELF. Offset Panes(deltaLPt); 

002543 

002544 {$I1FC fTrace}EP; {$ENDC} 

002545 END; 

002546 

002547 

002548 {$$ sError} 

002549 PROCEDURE {TSideBand. }Scroll To{(viewLCd: LONGI NT) }; 
002550 BEGIN 

002551 {SI1FC fTrace}BP( 6); {$ENDC} 

002552 ABCBreak('Can not do TSideBand. ScrollTo', 0); 

002553 {$IFC fTrace}EP; {$ENDC} 

002554 END; 

002555 

002556 

002557 {$S SgABCcl d} 

002558 FUNCTION {TSideBand. }ThumbPos{: INTEGER}; 

002559 BEGIN 

002560 {$I1FC fTrace}BP( 4); {$ENDC} 

002561 ThumbPos := 0: 

002562 {$I1FC fTrace}EP; {$ENDC} 

002563 END; 

002564 

002565 

002566 {$8 SgABCi ni } 

002567 END; 

002568 {$8 SgABCres} 

002569 

002570 

002571 

002572 METHODS OF TPane; 

002573 

002574 

002575 {$$ sCldil nit} 

002576 FUNCTION {TPane. }CREATE{(object: TObject; heap: THeap; itsPanel: TPanel; itsInnerRect: Rect; 
002577 itsViewedLRect: LRect): TPane}; 
002578 BEGIN 

002579 {$I1FC fTrace}BP(7); {$ENDC} 

002580 IF object = NIL THEN 

002581 object := NewObject(heap, THI SCLASS) 

002582 SELF := TPane(TPad.CREATE(object, heap, itsInnerRect, itsViewedLRect, screenRes, 
002583 screenRes, POINTER(itsPanel. window. wmgrld))); 
002584 

002585 SELF.currentView := itsPanel.currentView; {presumably unnecessary because will be done by haveVi ew} 
002586 SELF. panel := itsPanel 

002587 {$IFC fTrace}EP; {$ENDC} 
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END; 
{$S SgABCres} 


{$1 FC fDebugMet hods} 
{$8 SgABCdbg} 
PROCEDURE {TPane. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 
TPad. Fields( Field); 
Field('currentView: TView'); 
Field(' panel: TPanel') 
END; 
{$S SgABCres} 
{$ENDC} 


{$S sRes} 

FUNCTION {TPane. }CursorAt{(mousePt: Point): TCursorNumber}; 
{assumes mousePt is within the pane's innerRect} 
VAR mouseLPt: LPoint; 


panePt: Point; {window-relative, under the coordinate system defined by pane} 


BEGIN 
{$IFC fTrace}BP( 2); {$ENDC} 
PushFocus; 
panePt := mousePt; 
Local ToGl obal (panePt); 
SELF. Focus; 


Global ToLocal(panePt); {mousePt is now adjusted for the pane's new origin} 


SELF. PtToLPt(panePt, mouseLPt) 
IF LRectHasLPt(SELF.currentView.extentLRect, mouseLPt) THEN 


CursorAt := SELF. current View. CursorAt( mouseLPt) 
ELSE 
CursorAt := arrowCursor 
PopFocus; 
{$IFC fTrace}EP; {$ENDC} 
END: 
{$$ sRes} 


PROCEDURE {TPane. }GetScrollLimits{( VAR viewedLRect, scrollableLRect: LRect)}; 


VAR extra: Point: 

BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
viewedLRect := SELF.viewedLRect; 
WITH SELF. currentView DO 


BEGIN 
scrollableLRect := extentLRect; 
extra := scroll PastEnd 
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END; 
WITH scrollableLRect, extra DO 
BEGIN 
right = right + Max(0, Min(viewedLRect.right - viewedLRect.left - h, h)); 
bottom := bottom + Max(0, Min(viewedLRect. bottom - viewedLRect.top - v, v)); 
END; 
{$I FC fTrace}EP; {$ENDC} 
END; 
{$S sCldl nit} 
PROCEDURE {TPane. }HaveView{(view: TVi ew) }; 
VAR deltaLPt: LPoint 
vi ewedLRect: LRect; 
paneSi ze: Point; 
BEGIN 


{$I FC fTrace}BP(7); {$ENDC} 
SELF. currentView := view 
IF (view.res.h <> SELF. viewedRes.h) OR (view.res.v <> SELF. viewedRes.v) THEN 


BEGIN 
Pt MinusPt(SELF.innerRect. botRight, SELF.innerRect.topLeft, paneSize); 
viewedLRect := view. extentLRect; 


viewedLRect. right := viewedLRect.left + 
Lint Divi nt(ORD4( paneSize.h) * view.res.h, SELF. padRes. h) 
viewedLRect. bottom := viewedLRect.top + 
Lint Divi nt(ORD4( paneSize.v) * view.res.v, SELF. padRes. v) 
SELF. Redefine(SELF.innerRect, viewedLRect, SELF.padRes, view.res, SELF.zoomFactor, SELF. port); 
END 
ELSE 
BEGIN 
SetLPt(deltaLPt, view.extentLRect.left - SELF. viewedLRect. left, 
view.extentLRect.top - SELF. viewedLRect. top) 
SELF. Of fsetBy(deltaLPt); 
ND; 


END; 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S sRes} 
PROCEDURE {TPane. }MouseTrack{( mPhase: TMousePhase; mousePt: Point) }: 
{assumes mousePt is within the pane's innerRect; 
mousePt is window-relative, (0,0)-origined} 


VAR mouseLPt: LPoint 
panePt: Point; {window-relative, under the coordinate system defined by pane} 
current Vi ew: TView 
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002684 BEGIN 

002685 {$IFC fTrace}BP(7); {$ENDC} 

002686 PushFocus 

002687 

002688 panePt := mousePt; 

002689 Local ToGl obal (panePt) 

002690 SELF. Focus 

002691 Gl obal ToLocal(panePt); {mousePt is now adjusted for the pane's new origin} 
002692 SELF. PtToLPt( panePt, mouseLPt) 

002693 currentView := SELF.currentView 

002694 current View. MouseTrack( mPhase, mouseLPt) 

002695 PopFocus; 

002696 

002697 { &&& we should optimize the following -- SELF.CursorAt also does the same focusing as above } 
002698 process. ChangeCursor( SELF. CursorAt( mousePt) ); 

002699 {$I1FC fTrace}EP; {$ENDC} 

002700 END; 

002701 


002702 {$8 sStartup} 
002703 {+++LSR+++} {This whole method is substantially changed} 


002704 PROCEDURE {TPane. }Refresh{(rActions: TActions; highTransit: THighTransit) }; 
002705 

002706 VAR panel: TPanel 

002707 needGray: BOOLEAN; 

002708 vi ewExtentLRect: LRect; 

002709 vi ewedLRect: LRect; 

002710 tempLRect: LRect; 

002711 

002712 PROCEDURE Highlight OnThePad 

002713 BEGIN 

002714 panel.selection. Highlight(highTransit); 

002715 END; 

002716 

002717 BEGIN 

002718 {$I1FC fTrace}BP(7); {$ENDC} 

002719 panel := SELF. panel 

002720 

002721 viewExtentLRect := SELF.currentView. extentLRect; 

002722 viewedLRect := SELF.viewedLRect; 

002723 

002724 1F rFrame IN rActions THEN 

002725 SELF. Frame; 

002726 

002727 needGray := (rBackground IN rActions) AND 

002728 ((viewedLRect.right > viewExtentLRect.right) OR 
002729 (viewedLRect. bottom > viewExtentLRect. bottom) ) 
002730 

002731 IF rErase IN rActions THEN 
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SELF. Erase; 


1F (rDraw IN rActions) OR (highTransit <> hNone) OR needGray THEN 
BEGIN 
PushFocus: 
SELF. Focus; 


1F needGray THEN 
BEGIN 
PenNor mal ; 
PenSize(2, 2); 


{draw the vertical strip of gray ...} 
tempLRect := viewedLRect; 

tempLRect.left := viewExtentLRect. right; 
Fill LRect(tempLRect, | PatLtGray); 


{... then the horizontal strip ...} 
tempLRect := viewedLRect; 

tempLRect.top := viewExtentLRect. bottom 
Fill LRect(tempLRect, | PatLtGray); 


{... then frame the bottom right of the view extent with a 2-pixel line outside the extent; 
note that the topLeft does not matter} 

tempLRect.topLeft := viewedLRect.topLeft; 

tempLRect. bot Right := viewExtentLRect. bot Ri ght; 


InsetLRect(tempLRect, -2, -2); 
FrameLRect(tempLRect); 
END; 


IF rDraw IN rActions THEN 
SELF. currentView. Draw 


IF highTransit <> hNone THEN 
IF panel. previewMode = mPrvwMargins THEN 
panel. pagi natedVi ew. DoOnPages( TRUE, Hi ghli ght OnThePad) 
ELSE 
Hi ghl i ght OnThePad 


1F rDraw IN rActions THEN {Page breaks after highlighting, in case highlighting doesn't XOR} 
IF panel. previewMode = mPrvwBreaks THEN {Xors automatic as well as manual page breaks} 
SELF. current View. print Manager. DrawBreaks( FALSE) ; 


PopFocus; 

END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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002780 {$8 SgABCres} 


002781 

002782 

002783 {$$ sRes} 

002784 PROCEDURE {TPane. }Resize{(newlnnerRect: Rect; vhs: VHSel ect) }: 
002785 VAR innerRect: Rect; 

002786 paneLongSi ze: LPoint 

002787 BEGIN 

002788 {$I1FC fTrace}BP(7); {$ENDC} 

002789 innerRect := SELF.innerRect; 

002790 AlignRect(innerRect, newlnnerRect, vhs) 

002791 SELF. SetIl nnerRect(innerRect); 

002792 SELF.clippedRect := innerRect; 

002793 SELF. Dist ToLDist(Point(FDiagRect(innerRect)), paneLongSi ze) 
002794 {$H-} LPtPlusLPt(SELF.viewedLRect.topLeft, paneLongSize, SELF. viewedLRect. botRight); {$H+} 
002795 SELF. availLRect := SELF. viewedLRect; 

002796 {$H-} InsetLRect(SELF.availLRect, -8192, -8192); {$H+} 

002797 {$I1FC fTrace}EP; {$ENDC} 

002798 END; 

002799 

002800 

002801 {$$ sScroll } 

002802 PROCEDURE {TPane. }Scrol|lBy(VAR deltaLPt: LPoint); 

002803 VAR panel: TPanel 

002804 deltaPt: Point; 

002805 vhs: VHSel ect; 

002806 band: TBand; 

002807 tempPt: Point; 

002808 BEGIN 

002809 {$1FC fTrace}BP(5); {$ENDC} 

002810 panel := SELF. panel 

002811 

002812 IF panel. panes.Size = 1 THEN 

002813 BEGIN 

002814 PushFocus: 

002815 SELF. panel. window. Focus 

002816 

002817 panel. DoScrolling(SELF, SELF, TRUE, TRUE, deltaLPt); 
002818 1F NOT EqualLPt(deltaLPt, zeroLPt) THEN 

002819 BEGIN 

002820 SELF. Offset By(deltaLPt) 

002821 FOR vhs := v TO h DO 

002822 panel.scroll Bars[vhs].firstBox. MoveThumb( TBand( panel. bands[ vhs]. First). ThumbPos) ; 
002823 END; 

002824 

002825 PopFocus; 

002826 END 

002827 ELSE 


Apple Lisa ToolKit 3.0 Source Code Listing -- 329 of 1012 


Apple Lisa Computer Technical Information 


002828 FOR vhs := v TO h DO 

002829 BEGIN 

002830 band := TBand(panel. ChildWithPt(SELF.innerRect.topLeft, panel. bands[vhs], tempPt)); 
002831 band. Scrol! By(deltaLPt. vh[ vhs]) 

002832 END; 

002833 {$IFC fTrace}EP; {$ENDC} 

002834 END; 

002835 

002836 

002837 {$$ sScroll} 

002838 PROCEDURE {TPane. }ScrollToReveal (VAR anLRect: LRect; hMinToSee, vMinToSee: INTEGER); 
002839 VAR pt Mi nToSee: Point; 

002840 mi nToSee: INTEGER 

002841 vi ewedLRect: LRect; 

002842 deltaLPt: LPoint 

002843 vhs: VHSel ect; 

002844 lcd: LONGI NT; 

002845 BEGIN 

002846 {$1 FC fTrace}BP(5); {$ENDC} 

002847 viewedLRect := SELF.viewedLRect; 

002848 SetPt(ptMinToSee, hMinToSee, vMinToSee) 

002849 

002850 FOR vhs := v TO h DO 

002851 BEGIN 

002852 minToSee := Min(LengthRect(SELF.innerRect, vhs), ptMinToSee. vh[vhs]); 
002853 

002854 lcd := anLRect.topLeft.vh[ vhs] + minToSee - viewedLRect. botRi ght. vh[ vhs] 
002855 IF lcd <= 0 THEN 

002856 BEGIN 

002857 lcd := anLRect. botRight.vh[vhs] - minToSee - viewedLRect.topLeft.vh[ vhs] 
002858 1F lcd >= 0 THEN 

002859 Iced := 0: 

002860 END; 

002861 deltaLPt.vh[vhs] := Icd; 

002862 END; 

002863 

002864 SELF. Scroll By(deltaLPt); 

002865 {$I1FC fTrace}EP; {$ENDC} 

002866 END: 

002867 

002868 

002869 {$S SgABCcl d} 

002870 PROCEDURE {TPane. }SetZoomFactor{(zoomNumerator, zoomDenomi nator: Point) };: 
002871 VAR zoomFactor: TScaler 

002872 newLRi ght: LONGI NT; 

002873 newLBottom: LONGI NT; 

002874 newVi ewedLRect: LRect; 

002875 BEGIN 
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{$IFC fTrace}BP(9); {$ENDC} 
Reduce(zoomNumerator.h, zoomDenominator.h); {reduce to lowest terms} 
Reduce(zoomNumerator.v, zoomDenomi nator. v) 


{adjust viewed | Rect} 
newLRight := Mi n( 
(SELF.viewedLRect.right * zoomDenominator.h * SELF.zoomFactor. numerator. h) 
DIV ( zoomNumerator.h * SELF.zoomFactor.denomi nator.h), 
SELF. current View, extentLRect. right); 
newLBottom: = Mi n( 
(SELF. viewedLRect. bottom * zoomDenomi nator.v * SELF. zoomFactor. numerator. v) 
DIV ( zoomNumerator.v * SELF. zoomFactor. denomi nator. v), 
SELF. current View. extentLRect. bottom) 


SetLRect(newViewedLRect, SELF.viewedLRect.left, SELF.viewedLRect. top 
newLRight, newLBottom); 
Set Pt(zoomFactor. numerator, zoomNumerator.h, zoomNumerator.v); 
SetPt(zoomFactor. denominator, zoomDenominator.h, zoomDenomi nator.v); 
SELF. Redefine(SELF.innerRect, newViewedLRect, SELF.padRes, SELF.viewedRes, zoomFactor, SELF. port); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCi ni } 
END; 
{$$ SgABCres} 


METHODS OF TMarginPad; 


{$S SgABCi ni } 
FUNCTION {TMarginPad. }CREATE{(object: TObject; heap: THeap): TMarginPad}; 
VAR bodyPad: TBodyPad 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TMarginPad( obj ect); 


bodyPad := TBodyPad. CREATE(NIL, heap, SELF); 
SELF. bodyPad := bhodyPad 
{$1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 
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{$S SgABCpri } 
PROCEDURE {TMarginPad. }Rework{(itsView: TView; itsOrigin: Point; itsRes: Point; 
itsPageNumber: LONGINT; itsZoomFactor: TScaler; itsPort: GrafPtr)}; 
VAR itsViewedLRect: LRect; 
printerMetrics: TPrinterMetrics 
bodyPad: TBodyPad; 
innerRect: Rect; 


PROCEDURE ScaleToPadSpace(printRect: Rect; VAR padRect: Rect); 
VAR padLRect: LRect; 
{NB: itsOrigin is a free var in this proc} 
BEGIN 
SetLRect(padLRect, 
LI nt Ovri nt( ORD4(printRect. left) * itsRes.h * itsZoomFactor. numerator.h, {this whole stmt} 
printerMetrics.res.h * itsZoomFactor. denomi nator. h) 
LI nt Ovrl nt( ORD4(printRect. top) * itsRes.v * itsZoomFactor. numerator.v, 
printerMetrics.res.v * itsZoomFactor. denominator. v) 
Li ntOvrint(ORD4(printRect.right) * itsRes.h * itsZoomFactor. numerator.h, 
printerMetrics.res.h * itsZoomFactor. denomi nator. h) 
Li ntOvrint(ORD4(printRect. bottom) * itsRes.v * itsZoomFactor. numerator.v, 
printerMetrics.res.v * itsZoomFactor. denomi nator.v)); 
noPad. LRectToRect(padLRect, padRect); 
OffsetRect(padRect, itsOrigin.h, itsOrigin.v); 


END; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
SELF.view := itsView 
printerMetrics := SELF. view. print Manager. printerMetrics; 
SELF. pageNumber := itsPageNumber; 


ScaleToPadSpace(printerMetrics. paperRect, innerRect); 


SELF. Redefine(innerRect, SELF. view. print Manager. paperLRect, 


itsRes, {pad resolutions} 
itsView.res, {viewed resolutions} 
itsZoomFactor, itsPort); {calls TPad's Redefine method} 


{page's ‘viewed space’ has same metrics as the owning view's} 


SELF. bodyPad. Recomput e; 
{$SIFC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$8 SgABCi ni } 
PROCEDURE {TMarginPad. }Free; 
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BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
Free( SELF. bodyPad); 
TObj ect. Free; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$S SgABCpri } 
PROCEDURE {TMarginPad. }SetForPage{(itsPageNumber: LONGINT; itsOrigin: Point)}; 
VAR innerRect: Rect; 
newOffset: LPoint; 
BEGIN 
{$1FC fTrace}BP(7); {$ENDC} 
SELF. pageNumber := itsPageNumber; 
innerRect := SELF.innerRect; 
OffsetRect(innerRect, itsOrigin.h - SELF.innerRect.left, itsOrigin.v - SELF.innerRect. top); 
SELF. SetI nnerRect(innerRect); 


SELF.clippedRect := innerRect; 
WITH innerRect DO 
SetLPt(newOffset, - left, - top) 


SELF. SetScrollOffset(newOffset); 
SELF. bodyPad. Set ForPage(itsPageNumber); 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$1 FC fDebugMet hods} 
{$8 SgABCdbg} 
PROCEDURE {TMarginPad. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
BEGIN 
TPad. Fields( Field); 
Field('view: TView'); 
Field(' pageNumber: LONGI NT' ) 
Field('bodyPad: TBodyPad'); 


Field(''); 
END; 
{$S SgABCres} 
{$ENDC} 


{$1 FC fDbgABC} 
{$S SgABCdbg} 
FUNCTION TMarginPad. BindHeap{(activeVsClip, doBind: BOOLEAN): THeap}; {called by HeapDump in UOBJ ECT2} 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
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{$IFC fMaxTrace}EP; {$ENDC} 
BindHeap := NIL; 
(* IF activeWindowlD <> 0 THEN {don't allow inactive windows to use this} -- WHY NOT???? *) 
BEGIN 
IF activeVsClip THEN 
BEGIN 
(* IF (currentDocument <> NIL) AND doBind THEN 
BindHeap := current Document. docHeap; *) 
IF (boundDocument <> NIL) AND doBind THEN 
BindHeap := boundDocument. docHeap; 
END 
ELSE 
IF currentDocument <> clipboard THEN 
IF doBind THEN 
BEGIN 
hadToBindClip := boundClipboard = NIL; 
1F hadToBindClip THEN 
clipboard. Bind 
BindHeap := clipboard. docHeap; 
END 
ELSE |F hadToBindClip THEN 
clipboard. Unbind 
END; 
END; 
{$S SgABCres} 
{$ENDC} 


{$S SgABCcl d} 
PROCEDURE {TMarginPad. }Crash; 


BEGIN {SELF = crashPad, presumably, but in any case, someone wants this process to die, So... 


IF isinitialized THEN 
process. Compl ete( FALSE); 
END; 
{$S SgABCres} 


PROCEDURE TMarginPad. SetScrollOffset(VAR newOffset: LPoint); {+SW+} 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
1F fExperimenting OR NOT amPrinting THEN 
SUPERSELF. Set Scroll Offset ( new0f fset) 
ELSE 
WITH SELF DO 
BEGIN 
scrollOffset := newOffset: 
origin := zeroPt; 
cd0ffset := newOffset; 


Apple Lisa ToolKit 3.0 Source Code Listing -- 334 of 1012 


Apple Lisa Computer Technical Information 


003068 END; 

003069 {$1FC fTrace}EP; {$ENDC} 

003070 END; 

003071 

003072 

003073 {$8 SgABCi ni } 

003074 END; 

003075 {$8 SgABCres} 

003076 

003077 

003078 METHODS OF TBodyPad 

003079 

003080 

003081 {$S SgABCi ni } 

003082 FUNCTION {TBodyPad. }CREATE{(object: TObject; heap: THeap; itsMarginPad: TMarginPad): TBodyPad}; 
003083 BEGI N 

003084 {$IFC fTrace}BP( 9); {$ENDC} 
003085 IF object = NIL THEN 

003086 object := NewObject(heap, THISCLASS) 
003087 SELF := TBodyPad( object); 
003088 

003089 SELF. marginPad := itsMarginPad 
003090 {$I1FC fTrace}EP; {$ENDC} 

003091 END; 

003092 {$S SgABCres} 

003093 

003094 

003095 {$1 FC fDebugMet hods} 

003096 {$8 SgABCdbg} 

003097 PROCEDURE {TBodyPad. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
003098 BEGIN 

003099 TPad. Fields( Field) 

003100 Field('marginPad: TMarginPad' ) 
003101 Field('nonNull Body: Rect'); 
003102 END; 

003103 {$S SgABCres} 

003104 {$ENDC} 

003105 

003106 

003107 {$S SgABCpri } 

003108 PROCEDURE {TBodyPad. }Focus; 

003109 BEGI N 

003110 {$IFC fTrace}BP( 6); {$ENDC} 
003111 SELF. Cli pFurtherTo( SELF. nonNul | Body) ; 
003112 TPad. Focus 

003113 {$1 FC fTrace}EP; {$ENDC} 

003114 END; 

003115 {$S SgABCres} 
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PROCEDURE {TBodyPad. }Recompute 


BEGI 


END; 
{$5 


{$$ 


VAR myViewedLRect: LRect; 


my! nnerRect: Rect; 

view: TView; 

mar gi nPad: TMarginPad 

bodyRect: Rect; 

print Manager: TPri nt Manager 
N 


{$I1FC fTrace}BP(7); {$ENDC} 

marginPad := SELF. marginPad 

view := marginPad. view 

printManager := view. print Manager 

print Manager. Get PageLi mits(marginPad. pageNumber, myViewedLRect); 


marginPad. LRectToRect(printManager.contentLRect, mylnnerRect); 
WITH marginPad. origin DO {$H- } 
OffsetRect(myl nnerRect, -h, -v); {$H+} 


SELF. Redefine(myl nnerRect, myViewedLRect, marginPad. padRes, 
view.res, marginPad.zoomFactor, SELF. marginPad. port); 
bodyRect.topLeft := SELF.innerRect.topLeft; 
SELF. LPtToPt( myVi ewedLRect. botRight, bodyRect. botRi ght); 
bodyRect. botRight := Point(FPtMinusPt(bodyRect. botRight, SELF. origin) ) 


SELF. nonNul! Body := bodyRect; 
{$IFC fTrace}EP; {$ENDC} 


SgABCres} 


SgABCpri } 


PROCEDURE {TBodyPad. }SetForPage{(itsPageNumber: LONGI NT) }; 


BEGI 


VAR myViewedLRect: LRect; 


my! nnerRect: Rect; 
bodyRect: Rect; 
print Manager: TPri nt Manager 
newOffset: LPoint; 
N 
{$IFC fTrace}BP(7); {$ENDC} 
printManager := SELF. marginPad. view. print Manager 


print Manager. Get PageLimits(itsPageNumber, myViewedLRect); 
SELF. marginPad. LRectToRect(printManager.contentLRect, myl nnerRect); 
WITH SELF. marginPad.origin DO {$H-} 

OffsetRect(myl nnerRect, -h, -v); {$H+} 
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SELF. SetI nner Rect( myl nnerRect); 


WITH SELF, 
BEGIN 
viewedLRect := myViewedLRect; 
availLRect := myViewedLRect; 
InsetLRect(availLRect, -8192, 
clippedRect := myl nnerRect; 
IF scaled THEN 

BEGIN 
{$H- } hse 


Vie 


newOffset, scaleFactor DO 


{$H-} -8192);  {$H+} 


- myl nnerRect. left; 
LI nt Ovri nt (Lint Mull nt( myVi ewedLRect.top 
- mylnnerRect.top; {$H+} 


numerator.v), 


END 

ELSE 
BEGIN 
h := myViewedLRect.left - mylnnerRect. left; 
v := myViewedLRect.top - myl nnerRect. top; 
END; 


END; 
SELF. SetScrollOffset(newOffset): 


SELF. nonNull Body := SELF.innerRect; 
SELF. LPtToPt( myVi ewedLRect. bot Ri ght, 
SELF. nonNul! Body. botRight := 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$H-} SELF. nonNul | Body. bot Ri ght) 


PROCEDURE TBodyPad. Set Scroll Offset( VAR newOffset 
BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
1F fExperimenting OR NOT amPrinting THEN 
SUPERSELF. Set Scroll Offset ( newOf fset) 
ELSE 
WITH SELF DO 
BEGIN 
scrollOffset := newOffset:; 
origin := zeroPt; 
cd0ffset := newOffset; 


LPoint); {+SW+} 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCi ni} 
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Point (FPtMi nus Pt( SELF. nonNull Body. bot Ri ght, 


Lint Ovrint( Lint Mull nt( myViewedLRect.|eft, numerator.h), denominator. h) {+++LSR+++} 


denominator.v) {+t+LSR+++} 


SELF. origin)); {$H+} 
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END; 
{$$ SgABCres} 


METHODS OF TScroller:; 


{$$ sCldl nit} 

FUNCTION {TScroller. }CREATE{(object: TObject; heap: THeap; itsScroll Bar: 
:TScroller}; 

BEGIN 


{$IFC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 

object := NewObject(heap, THISCLASS) 
SELF := TScroller(obj ect); 


WITH SELF DO 
BEGIN 
scroll Bar := itsScrollBar 
band := NIL; 
sBoxID := itsld; 
{$H-} SetSbRefcon( POINTER(sBoxID), ORD(SELF)); {$H+} 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$8 SgABCi ni } 

PROCEDURE {TScroller. }Free 
VAR sbList: TSbList; 

BEGIN 
{$1FC fTrace}BP(7); {$ENDC} 
PreSbList(sbList, SELF.scroll Bar); 

{$H-} Kill Sb(sbList, POINTER(SELF.sBoxID)); {$H+} 

PostSbList(sbList, SELF.scroll Bar); 
TObj ect. Free; 
{$1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$1 FC fDebugMet hods} 
{$S SgABCdbg} 
PROCEDURE {TScroller. }Fields{(PROCEDURE Field(nameAndType: $255))}; 
BEGIN 
Field('scroll Bar: TScrollBar'); 
Field('band: TBand'); 
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Field('sBox!D: LONGI NT' ) 
END; 
{$S SgABCres} 
{$ENDC} 


{$$ sScroll } 
PROCEDURE {TScroller. }Filllcon{(icon: TEnumlcons; f Black: BOOLEAN) }: 
TYPE TlconAlias = 
RECORD 
CASE INTEGER OF 
1: (sblib: Tlcon); 
2: (abe: TEnuml cons); 
END; 
VAR iconAlias: Tl conAlias 
BEGIN 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 


iconAlias.abc := icon; 
PaintArw( POINTER(SELF.sBoxID), iconAlias.sblib, fBlack); 
END; 
{$$ sRes} 
PROCEDURE {TScroller. }GetSize{(VAR boxRect: Rect) }; 
BEGIN 


{$IFC fTrace}BP( 3); {$ENDC} 
GetSbRect( POI NTER(SELF.sBoxID), boxRect); 
{$IFC fTrace}EP; {$ENDC} 

END; 


{$$ sScroll} 
PROCEDURE {TScroller. }MoveThumb{(newThumbPos: INTEGER) };: 
{NOTE: assumes we are focused on the window, NOT on a pane} 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
IF activeWindowlD <> 0 THEN 
BEGIN 
Set upMvThumb( POI NTER( SELF. sbox! D)); 
MoveThumb(newThumbPos); 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sSplit} 
PROCEDURE {TScroller. }ResplitAt{(newSkwrCd: INTEGER; prevScroller: TScroller)}; 
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VAR vhs: VHSel ect; 
sbRect: Rect; 
prevSbRect: Rect; 
hsb: THSb; 
deltaCd: INTEGER; 
mi nSize: INTEGER 

BEGIN 


{$IFC fTrace}BP(7); {$ENDC} 

vhs := SELF. Scroll Dir; 

mi nSize := dptSkewer. vh[ vhs] 

hsb := POINTER(SELF.sBox!D); 
GetSbRect(hsb, sbRect); 
prevScroller. Get Size(prevSbRect); 


{If either scroller to becomes too small, delete it} 

IF newSkwrCd <= prevSbRect.topLeft.vh[vhs] + minSize THEN 
newSkwrCd := prevSbRect.topLeft. vh[ vhs] 

ELSE |1F newSkwrCd >= sbRect. botRight.vh[vhs] - minSize THEN 
newSkwrCd := sbRect. botRi ght. vh[ vhs] 


deltaCd := newSkwrCd - sbRect.topLeft.vh[vhs] 
Adj SplitBetween( POINTER(prevScroller.sBoxID), hsb, deltaCd); 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$$ sRes} 
FUNCTION {TScroller. }Scroll Dir{: VHSel ect}; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
Scroll Dir := TyVHOfSb( POI NTER(SELF.sBoxlD)); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE {TScroller. }SetSize{(ownerRect: Rect) }; 
VAR sbRect: Rect; 
vhs: VHSelect; 
width: INTEGER; 


{ownerRect is the band's outerRect. 

For v bar: top/bottom = ownerRect top/ bottom 
left = ownerRect right - 1 
right = left + dhSBox} 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
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vhs := orthogonal [SELF. Scroll Dir] 
sbRect := ownerRect; 
sbRect.topLeft.vh[ vhs] := sbRect. botRight.vh[vhs] - 1; 
IF SELF.scrollBar.isVisible THEN 
width := dptSbox. vh[ vhs] 
ELSE 
width := 0: 
sbRect. botRight.vh[vhs] := sbRect.topLeft.vh[vhs] + width; 


SetSbRect(POINTER(SELF.sBoxlD), sbRect); 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgABCres} 


{$S sSplit} 
PROCEDURE {TScroller. }SplitAt{(newSkwrCd: INTEGER; VAR nextScroller: TScroller)}; 
VAR newHsb: THsb 
sbList: TSbList; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
PreSbList(sbList, SELF.scroll Bar); 
SplitSb(sbList, POINTER(SELF.sBoxID), newHsb, newSkwr Cd) 
PostSbList(sbList, SELF.scroll Bar); 
nextScroller := TScroller.CREATE( NIL, SELF.Heap, SELF.scroll Bar, ORD( newHsb) ) 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$S SgABCres} 


{$$ sScroll} 
FUNCTION {TScroller. }ThumbRange{: INTEGER}; 
VAR posts: TPosts; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
MkPosts(POINTER(SELF.sBoxID), posts); 
ThumbRange := posts[iconGryB] - posts[iconPagA] - dptThumb. vh[ SELF. Scroll Dir] 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sSplit} 
PROCEDURE {TScroller. }}TrackSkewer{( mousePt: Point; VAR newSkwrCd: INTEGER 
VAR scroller, prevScroller: TScroller)}; 
VAR hsb, prevHsb: THsb; 


sbList: TSbLi st; 
limitRect: Rect; 
newSkwr Pt: Poi nt; 
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003404 BEGIN 

003405 {$I1FC fTrace}BP(7); {$ENDC} 

003406 hsb := POI NTER( SELF. s Box! D) 

003407 FiXRLimits(hsb, limitRect); 

003408 AlignRect(limitRect, SELF. band. outerRect, orthogonal [SELF. Scroll Dir] ) 
003409 DragSkewer(hsb, mousePt, limitRect, newSkwr Pt) 
003410 newSkwrCd := newSkwrPt. vh[SELF. Scroll Dir] 
003411 prevHsb: = HsbPrev( hsb) 

003412 [F prevHsb = hsbNil THEN 

003413 BEGIN 

003414 PreSbList(sbList, SELF.scroll Bar); 

003415 hsb := HsbFromPt(sbList, newSkwr Pt) 

003416 PostSbList(sbList, SELF.scroll Bar); 

003417 IF hsb = hsbNil THEN 

003418 scroller := NIL 

003419 ELSE 

003420 scroller := POINTER( Ref conSb(hsb)); 
003421 prevScroller := NIL; 

003422 END 

003423 ELSE 

003424 BEGIN 

003425 scroller := SELF: 

003426 prevScroller := POINTER( Ref conSb( prevHsb) ) 
003427 END; 

003428 {$I1FC fTrace}EP; {$ENDC} 

003429 END; 

003430 

003431 

003432 {$$ sScroll } 

003433 PROCEDURE {TScroller. }TrackThumb{( mousePt: Point; VAR ol dThumbPos, newThumbPos: | NTEGER) }; 
003434 BEGIN 

003435 {$I1FC fTrace}BP(7); {$ENDC} 

003436 oldThumbPos := CThumbPos( POI NTER( SELF. sBoxl D) ) 
003437 DragThumb( POI NTER(SELF.sBox!D), mousePt, newThumbPos) 
003438 {$I1FC fTrace}EP; {$ENDC} 

003439 END: 

003440 

003441 

003442 {$8 SgABCi ni } 

003443 END; 

003444 {$8 SgABCres} 

003445 

003446 

003447 METHODS OF TScroll Bar 

003448 

003449 

003450 {$8 SgABCi ni } 

003451 FUNCTION {TScroll Bar. }CREATE{(object: TObject; heap: THeap; vhs: VHSelect; outerRect: Rect 
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003452 itsVisibility: BOOLEAN): TScroll Bar}; 
003453 VAR sbList: TSbList; 

003454 hsb: THSb; 

003455 firstBox: TScroller 

003456 BEGIN 

003457 {$I1FC fTrace}BP(7); {$ENDC} 

003458 IF object = NIL THEN 

003459 object := NewObject(heap, THISCLASS) 

003460 SELF := TScroll Bar( object); 

003461 

003462 InitSbList(sbList, POINTER( ORD( heap) )); 

003463 hsb := SbCreate(sbList, hsbNil, vhs, zeroPt, 0) 

003464 PostSbList(sbList, SELF) 

003465 

003466 firstBox := TScroller.CREATE(NIL, heap, SELF, ORD(hsb)); 
003467 SELF. firstBox := firstBox: 

003468 

003469 SELF. ChangeVisibility(itsVisibility, outerRect, []); {The band's outerRect} 
003470 {$1FC fTrace}EP; {$ENDC} 

003471 END; 

003472 {$S SgABCres} 

003473 

003474 

003475 {$1 FC fDebugMet hods} 

003476 {$8 SgABCdbg} 

003477 PROCEDURE {TScroll Bar. }Fields{( PROCEDURE Field(nameAndType: $255))}; 
003478 BEGIN 

003479 Field('firstBox: TScroller'); 

003480 Field('isVisible: BOOLEAN' ) 

003481 Field(''); 

003482 END; 

003483 {$S SgABCres} 

003484 {$ENDC} 

003485 

003486 

003487 {$$ sCldl nit} 

003488 PROCEDURE {TScroll Bar. }ChangeVisibility{(needsBothBars: BOOLEAN 
003489 bandOuterRect: Rect; itsAbilities: TAbilities) };: 
003490 VAR hsb: THsb; 

003491 scroller: TScroller; 

003492 needsThisBar: BOOLEAN 

003493 icons: TSI con; 

003494 BEGIN 

003495 {$I1FC fTrace}BP(7); {$ENDC} 

003496 needsThisBar := needsBothBars OR (aBar IN itsAbilities); 
003497 SELF.isVisible := needsThisBar 

003498 icons := []; 

003499 1F needsThisBar THEN 
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BEGIN {if no bar, then no icons} 
IF aScroll IN itsAbilities THEN 


icons := icons + [iconArwA, iconArwB, iconThumb, 
IF aSplit IN itsAbilities THEN 
icons := icons + [iconSkewer] 


END; 
hsb := POINTER( SELF. first Box. sBox! D) 
WHILE hsb <> hsbNil DO 


BEGIN 
scroller := TScroller(RefconSb( hsb) ) 
IF scroller. band <> NIL THEN 
bandOuterRect := scroller. band. outerRect; 


scroller. SetSize( bandOuterRect); 
SetSblcons(hsb, icons); 
hsb := HsbNext(hsb); 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$8 sScroll} 
FUNCTION {TScroll Bar. }DownAt{(mousePt: Point; VAR scroller: 
TYPE TilconAlias = 
RECORD 
CASE INTEGER OF 
1: (sblib: Tlcon); 


2: (abc: TEnuml cons); 
END: 
VAR iconAlias: Tl conAlias 
hsbHit: THSb; 
sbList: TSbList; 


BEGIN 
{$1FC fTrace}BP(7); {$ENDC} 
DownAt := FALSE; 


IF SELF.isVisible THEN 
BEGIN 
PreSbList(sbList, SELF); 


iconPagA, iconPagB] 


TScroller; VAR icon: 


{$H-} |F FSbHit(sbList, mousePt, hsbHit, iconAlias.sbLib) {$H+} THEN 


BEGIN 

DownAt := TRUE; 

scroller := POINTER(RefconSb(hsbHit)); 
icon := iconAlias. abc; 

END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$S sStartup} 
PROCEDURE {TScroll Bar. }Draw 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
IF SELF.isVisible THEN 
Pai ntSbar( POI NTER( SELF. firstBox. sBoxl D)); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sStartup} 
PROCEDURE {TScroll Bar. }Erase 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 

IF SELF.isVisible THEN 

EraseSBar( POI NTER(SELF.firstBox. sBoxl D)); 

{$IFC fTrace}EP; {$ENDC} 
END; 


SgABCi ni } 
SgABCres} 
SgABCi ni } 


Lines: 3573 Characters: 114796 
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000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


(* >>>>>>>> 
*) 

{$SETC forOS := TRUE 
UNIT UDialog; {Copy 


{04/25/84 0015 
{04/23/84 1210 
{$Setc IsiIntrinsic 


{$1 FC Islntrinsic} 
INTRINSIC: 
{$ENDC} 


INTERFACE 


USES 
{$U libtk/ UObj ect} 
{$1FC LibraryVersion 
{$U UFont} 
{$ENDC} 
{$U QuickDraw} 
{$U libtk/ UDraw} 


i bt k/ UABC} 


{$U | 
{$U libtk/ UWnivText} 
{$U | 


i bt k/ UText } 


CONST 
UDi al ogVersion 


(* 


UDI ALOG <<<<<<<< 
} 
right 1984 by Apple Computer, Inc} 


MousePress, MouseMove, and MouseRel ease} 


:= TRUE } 


UObj ect, 
<= 20} 
UFont, 


Qui ckDraw 
UDraw, 


UABC, 
UTKUni versal Text 
UText; 


= 'UDialog 25Apr84 16: 30' 


Dialog Building Block for the ToolKit 


Removed all references to 'underEdit' field of TDi al ogl mage} 


The Dialog Building Block provides the following standard kinds of dialog I mages: 
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000044 

000045 Button A Lisa-style button (a round-cornered Rectangle for pushing, with text inside it) 
000046 Checkbox A checkbox (a box for checking, plus an optional associated textual label) 

000047 Cluster A set of related checkboxes of which only one is selected at a time 

000048 Input Frame A place for keyboard input to be inhaled 

000049 Legend A character string, together with font & face information 

000050 

000051 TextDialogl mage <A box of text managed by the Text editor (largely untested) 

000052 Pi cObj ect A QuickDraw picture (never tested; probably not bankable; status uncertain) 
000053 


000054 The basic bankable dialog entity which can be stashed into/retrieved froma Resource File 
000055 is the class TDialog. For each different kind of dialog box you want, you will typically define 
000056 another subclass of TDialog. 


000057 

000058 To EDIT a dialog interactively, you must: 

000059 (1) Have the menu items ‘Edit Dialog' and ‘Stop Editing Dialog' in your phrase-file 

000060 (2) If the dialog is viewed in your main window rather than in a dialog box, (such as Preferences) 
000061 then your own main Window. CanDoCmd should enable uEditDialog whenever the dialog to be editted 
000062 is unambiguously selected in the window and there is not a dialog box up; in this 

000063 case, the dialog editting takes place in a dialog box whereas the dialog itself resides 
000064 in the main window 

000065 

000066 CAUTION: Until Resource Files are incoporated, the edits to a dialog are local to the document 
000067 in which you made the edits, as well as documents made froma stationery pad made from 
000068 that document. 

000069 

000070 How to have your own view be a subclass of TDialogView, and still do all of its normal View things 
000071 while having the Dialog Building Block handle everything that occurs which is relevant to 

000072 its dialogs: 

000073 

000074 (a) To draw the non-dialog parts of the view, implement method TDi al ogView. XDraw 

000075 (b) To set the cursor in the non-dialog parts of the view, implement method TDialogView. XCursorAt 
000076 (c) Implement XMousePress, XMouseMove, and XMouseRelease instead of their non-x counterparts 
000077 

000078 *) 

000079 

000080 TYPE 

000081 

000082 S4 = STRING[ 4] 

000083 

000084 Tid = STRING[I DLength]; 

000085 

000086 TButtonMetrics = 

000087 RECORD 

000088 hei ght: INTEGER 

000089 curv: INTEGER; 

000090 curvV: INTEGER; 

000091 
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000092 typeStyle: TTypeStyle 

000093 

000094 expandNum: INTEGER; {a button's min width is its text's with times this numerator} 
000095 expandDen: | NTEGER; { ... divided by this denomi nator} 

000096 

000097 absMi nWidth: INTEGER 

000098 penState: PenState; {for drawing the round-rect} 

000099 END; 

000100 

000101 TStringKey = RECORD {Keys for Dialogs in Resource Files} 

000102 trueKey: LONGI NT; 

000103 key: $4; 

000104 END; 

000105 

000106 

000107 

O00108) Nescetlcatice elect enioeede tees igideheieea tock ecerticatateasieetaedcameites Heamatieees tes } 
000109 

000111 

000112 { cence reece eee eee eee eee classes i mpl emented in file UDi al og2 iets eo eee cee ee ee ee } 
000113 

000114 

000115 TDialogWindow = SUBCLASS of TDialogBox {which itself is in UABC} 

000116 

000117 control Panel: TPanel; {One with a dialogViewin it; may be told to push its dflt button} 
000118 dial ogVi ew: TDialogView; {the view installed in SELF. control Panel } 

000119 mai nDi al og: TDi al og; {the first dialog installed in SELF. dial ogVi ew} 

000120 

000121 {Creation/ Destruction} 

000122 FUNCTION TDi al ogWindow. CREATE(object: TObject; heap: THeap; itsResizability: BOOLEAN 

000123 itsHeight: INTEGER; itsKeyResponse, itsMenuResponse, itsDownl nMai nW ndowResponse: TDiResponse) 
000124 : TDialogWi ndow 

000125 

000126 {Showing and Hiding} 

000127 PROCEDURE TDi alogWndow. Appear; OVERRIDE; 

000128 PROCEDURE TDi al ogWndow. BeDismissed; OVERRIDE; 

000129 FUNCTION TDialogWndow. CanDoCommand(cmdNumber: TCmdNumber; VAR checklt: BOOLEAN): BOOLEAN; OVERRIDE; 
000130 PROCEDURE TDialogWndow. Disappear; OVERRI DE; 

000131 

000132 {Commands } 

000133 FUNCTION TDialogWndow. NewCommand(cmdNumber: TCmdNumber): TCommand; OVERRI DE; 

000134 

000135 END; {TDi al ogWindow interface} 

000136 

000137 

it ei er ert en rer er eT rer en ee re eer rere eT rer ee eT ee re ee Te er ee ee eee } 
000139 
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000140 
000141 
000142 
000143 
000144 
000145 
000146 
000147 
000148 
000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
000158 
000159 
000160 
000161 
000162 
000163 
000164 
000165 
000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 


{I nstalling, 


{Buttons and 


TDi alogView = SUBCLASS OF TView 


root Di al og: 


nonDi alogExtent: 


current Di al og! mage: 


defaultButton: 
hit Button: 
isShowi ng: 


pai nt FreeBoxes: 
pai nt Sense: 
startedPai nti ng: 
styl eSheet: 


mousel sDown: 
magnet Cursor: 
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{a view which contains dialog images as well as, possibly, other things} 
TDi al og; {The children of this object are the constituent Dialogs of this view} 
LRect; {intinsic overall extent, dialog + non-dialog actually} 


TDialogl mage; {which descendent owns the mouse during drag} 


TButton; {which if any button is the default} 

TButton; {which Button was last chosen} 

BOOLEAN; {used to suppress meaningless screen actions for not-yet-showing box} 
BOOLEAN; {whether free-checkboxes are to be painted in one sense only} 
BOOLEAN; { ... and if so, in which sense } 

BOOLEAN; {whether we've begun to paint and hence established pai ntSense} 


TStyleSheet; {for use by text images seen in the view} 


BOOLEAN; 
TCursorNumber;: {to force CursorAt to return this value until mouselsDown is FALSE} 


{ *** Public Interface *** } 
{Creation/ Destruction} 
FUNCTION TDialogView. CREATE(object: TObject; heap: THeap 


itsExtentLRect: LRect; itsPanel: TPanel 


itsPrintManager: TPrintManager; itsRes: Point): TDialogView 
PROCEDURE TDialogView. Free; OVERRI DE; 


Removing, Activating, Deactivating dialogs} 


PROCEDURE TDi al ogView. AddDi al og(dialog: TDialog); 

FUNCTION TDi al ogView. AddNewDialog(itsKey: $4): TDialog 

PROCEDURE TDi al ogView. ActivateDialog(dialog: TDialog; whichWay: BOOLEAN) 
PROCEDURE TDi al ogView. RemoveDialog(dialog: TDialog; andFree: BOOLEAN) 
PROCEDURE TDi al ogView. Repl aceDi al og(oldDialog, newDialog: TDi al og) 


FUNCTI ON 


{Methods which client should redefine to get a dialogView also to have non-dialog behaviour} 
TDi al ogView. XCursorAt(mouseLPt: LPoint): TCursorNumber; DEFAULT; 


PROCEDURE TDialogView. XDraw; DEFAULT 

PROCEDURE TDial ogView. XMousePress(mouseLPt: LPoint); DEFAULT; 
PROCEDURE TDi al ogView. XMouseMove( mouseLPt: LPoint); DEFAULT 
PROCEDURE TDi al ogView. XMouseRel ease; DEFAULT; 


checkboxes } 


PROCEDURE TDi al ogVi ew. AbandonThat Button; 


PROCEDURE TDialogView. ButtonPushed( button: TButton) 


{normally, TDialog's ButtonPushed is used} 


PROCEDURE TDial ogView. CheckboxHit(checkbox: TCheckbox; toggleDirection: BOOLEAN) 


PROCEDURE TDialogView. PushButton( button: TButton); 


{client or ToolKit may call} 


PROCEDURE TDial ogView. Set DefaultButton( button: TButton) 
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000188 {NB: PushButton sets the dialogView's hitButton to the requested button, assures that it 
000189 is highlighted, and then calls the client's ButtonPushed method of the TDialog which 
000190 is the parent of the button} 

000191 

000192 { *** Private Interface *** (Methods not expected to be redefined or called by client) } 

000193 FUNCTION TDialogView. CursorAt(mouseLPt: LPoint): TCursorNumber; OVERRIDE; 

000194 PROCEDURE TDialogView. Draw; OVERRI DE; 

000195 PROCEDURE TDi al ogView. EachActual Part( PROCEDURE DoToObject(filteredObj: TObject)); OVERRI DE; 
000196 PROCEDURE TDi al ogView. MouseMove(mouseLPt: LPoint); OVERRIDE; 

000197 PROCEDURE TDialogView. MousePress( mouseLPt: LPoint); OVERRIDE; 

000198 PROCEDURE TDial ogView. MouseRelease; OVERRIDE; 

000199 PROCEDURE TDialogView. RecalcExtent; OVERRIDE; 

000200 

000201 END; {TDialogView interface} 

000202 

OON202) (Petiesencin te teece tbe cauler aul cdawaclan haere rnaek hacia eee amiie bettie tai gale nce aa ome walk sai amr uae Ae } 
000204 

000205 

000206 TDialogl mage = SUBCLASS OF TI mage 

000207 

000208 parent: TDi al ogl mage 

000209 isActive: BOOLEAN 

000210 isEditable: BOOLEAN 

000211 wi t hl D: BOOLEAN 

000212 

000213 {Creation/ destruction} 

000214 FUNCTION TDialogl mage. CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsld: $255; 
000215 itsView: TView; withChildren: BOOLEAN): TDialogl mage 

000216 

000217 PROCEDURE TDi alogl mage. ControlHit(control: TDialogl mage; toggleDirection: BOOLEAN); DEFAULT 
000218 FUNCTION TDi alogl mage. DownAt(mouseLPt: LPoint): TDialogl mage; DEFAULT 

000219 PROCEDURE TDi alogl mage. Draw; OVERRI DE; 

000220 PROCEDURE TDi alogl mage. Draw) ustMe; {called by Draw after children, if any, are told to draw} DEFAULT 
000221 FUNCTION TDi alogl mage. LaunchLayout Box(view: TView): Tl mage; OVERRIDE; 

000222 PROCEDURE TDi al ogl mage. PrepareToAppear 

000223 PROCEDURE TDialogl mage. RecalcExtent; OVERRIDE; 

000224 FUNCTION TDi alogl mage. Still MyMouse(mouseLPt: LPoint): BOOLEAN; DEFAULT 

000225 

000226 {The following methods are stubs, redefined in Tl mageWthl D} 

000227 PROCEDURE TDi al ogl mage. Addl mage(dialogl mage: TDialogl mage); DEFAULT 

000228 PROCEDURE TDi al ogl mage. Activatel mage(dialogl mage: TDialogl mage; whichWay: BOOLEAN); DEFAULT; 
000229 PROCEDURE TDi al ogl mage. BringToFront(dialogl mage: TDialogl mage); DEFAULT 

000230 PROCEDURE TDi al og! mage. ComeForward; DEFAULT; 

000231 PROCEDURE TDi al ogl mage. Del etel mage(dialogl mage: TDialogl mage; andFree: BOOLEAN); DEFAULT; 
000232 PROCEDURE TDialogl mage. EachActual Part( PROCEDURE DoToObject(filteredObj: TObject)); OVERRIDE; 
000233 FUNCTION TDialogl mage. Hasld(id: $255): BOOLEAN; DEFAULT; 

000234 FUNCTION TDialogl mage. Obj ect Mthl DNumber(idNumber: INTEGER): TDialogl mage; DEFAULT; 

000235 FUNCTION TDialogl mage. Obj Withl d(id: $255): TDialogl mage; DEFAULT 
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000236 
000237 
000238 
000239 
000240 
000241 
000242 
000243 
000244 
000245 
000246 
000247 
000248 
000249 
000250 
000251 
000252 
000253 
000254 
000255 
000256 
000257 
000258 
000259 
000260 
000261 
000262 
000263 
000264 
000265 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 
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PROCEDURE TDialogl mage. Replacel mage(replacee, newValue: TDialogl mage); DEFAULT; 


END; 


Tl mageWithID = SUBCLASS OF TDialogl mage {same interface as TDialoglmage, basically} 


children: TList; {of TDialogl mage} 
id: Tld; 
idNumber: INTEGER; 


FUNCTION TilmageWithID. CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsld: $255; 
itsView: TView; withChildren: BOOLEAN): Tl mageWthl D; 

FUNCTION TimageWithID.Clone(heap: THeap): TObj ect; OVERRI DE; 

PROCEDURE Tl mageWithID. Free; OVERRI DE; 


PROCEDURE TI mageWithl 
PROCEDURE TI mageWithl 
PROCEDURE TI mageWithl 
FUNCTION Tl mageWithl 
PROCEDURE TI mageWithl 
PROCEDURE TI mageWit hl 
PROCEDURE Tl mageWthl D. EachActual Part( PROCEDURE DoToObject(filteredObj: TObject)); OVERRIDE; 
PROCEDURE Til mageWthl D. EachVirtual Part( PROCEDURE DoToObj ect(filteredObj: TObject)); OVERRIDE; 


D. Addl mage(dialogl mage: TDialogl mage); OVERRI DE; 
D. 
D. 
D. 
D. 
D. 
D. 
D. 
FUNCTION TimageWithID. Hasid(id: $255): BOOLEAN; OVERRI DE; 
D. 
D. 
D. 
D. 
D. 
D. 
D. 
D. 


Activatel mage(dialogl mage: TDialogl mage; whichWay: BOOLEAN); OVERRIDE; 
BringToFront(dialogl mage: TDialogl mage); OVERRI DE; 

CursorAt(mouseLPt: LPoint): TCursorNumber; OVERRI DE; 

Deletel mage(dialogl mage: TDialogl mage; andFree: BOOLEAN); OVERRI DE; 
Draw; OVERRIDE; 


PROCEDURE Til mageWthl D. HaveView(view: TView); OVERRIDE; 

FUNCTION TilmageWthl D. LaunchLayout Box(view: TView): Tl mage; OVERRIDE; 

FUNCTION TimageWithID. ObjectWthl DNumber(idNumber: INTEGER): TDialogl mage; OVERRIDE; 
FUNCTION TimageWithID. Obj WthId(id: $255): TDialoglmage; OVERRIDE; 

PROCEDURE Ti mageWithl D. Off SetBy(deltaLPt: LPoint); OVERRIDE; 

PROCEDURE Tl mageWithl D. RecalcExtent; OVERRI DE; 

PROCEDURE Ti mageWithID. Repl acel mage(replacee, newValue: TDialogl mage); OVERRIDE; 
FUNCTION TilmageWthI D. Still MyMouse(mouseLPt : LPoint): BOOLEAN; OVERRIDE; 


END; 


TDialog = SUBCLASS OF Tl mageWthID 

stringKey: TStringKey; {essentially a unique 4-character ID by which this dialog is known} 
{Creation} 

FUNCTION TDialog.CREATE(object: TObject; heap: THeap; itsKey: $4; itsView: TView): TDialog 


{Creation of the basic dialog elements: } 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
000295 
000296 
000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 
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{Elements originating from phrase file; in each case, the text for the legend associated with the 
component, if any, as well as a LOCATION for the component, are obtained fromthe same entry 
in the phrase file, with the syntax 


<text >@<h-coordinate>, <v- coordi nate> 
EXAMPLE: Suppose the following 2 lines are in the Phrase File: 


449 
Next @430, 50 


If we call NewButton(449, ...), then a button is created, with the text 'Next' inside it; 
the button is given idNumber 449, and is located at (430, 50)} 


(FERRER RRR RRR EKER RRR ER EKER ARH PUBLIC TL NTERFACE -- USE THESE METHODS **** #44 XH RRERERER EKER ERE KEKE RHE RE} 


FUNCTION TDialog.NewButton(itsPhrase: INTEGER; itsMetrics: TButtonMetrics; sameSizedButton: TButton; 
itsCmdNumber: TCmdNumber): TButton 


FUNCTION TDialog.NewCluster(itsPhrase: INTEGER): TCluster 


FUNCTION TDialog.NewFreeCheckbox(itsPhrase: INTEGER; boxWdth: INTEGER 
boxHei ght: INTEGER; wantLabel: BOOLEAN; label Offset: Point; itsTypeStyle: TTypeStyle): TCheckBox; 


FUNCTION TDialog.NewlnputFrame(itsPhrase: INTEGER; promptTypeStyle: TTypeStyle; 
input Offset: Point; inputTypeStyle: TTypeStyle 
maxi nputChars: INTEGER; itsBorders: Rect; drawlnputLRect: BOOLEAN 
drawHitLRect: BOOLEAN): Tl nputFrame; 


FUNCTION TDialog.NewLegend(itsPhrase: INTEGER; itsTypeStyle: TTypeStyle): TLegend 


FUNCTION TDialog. NewRowOf Boxes(itsPhrase: INTEGER; numberOf Boxes: INTEGER 
startingl DNumber: INTEGER; boxWidth: INTEGER; boxHeight: INTEGER; boxSpacing: INTEGER): TCluster; 


{controls} 
PROCEDURE TDialog. ButtonPushed( button: TButton); DEFAULT; {client overrides often} 
PROCEDURE TDialog. CheckboxHit(checkbox: TCheckbox; toggleDirection: BOOLEAN); DEFAULT; 

{client overrides someti mes} 

PROCEDURE TDialog. Control Hit(control: TDialogl mage; toggleDirection: BOOLEAN); OVERRI DE; 
PROCEDURE TDialog.PushButton( button: TButton); {client or ToolKit may call} 
PROCEDURE TDi alog.SelectI nputFrame(inputFrame: Ti nputFrame); 
PROCEDURE TDialog. Set Default Button( button: TButton) 


POCCOGOO OO SCCCCGOO CCGG OOO PRIVATE [NTERFACE 220K KKH KEE] 


{These methods of TDialog are largely either for internal use of the building block, or maintained for 
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000332 
000333 
000334 
000335 
000336 
000337 
000338 
000339 
000340 
000341 
000342 
000343 
000344 
000345 
000346 
000347 
000348 
000349 
000350 
000351 
000352 
000353 
000354 
000355 
000356 
000357 
000358 
000359 
000360 
000361 
000362 
000363 
000364 
000365 
000366 
000367 
000368 
000369 
000370 
000371 
000372 
000373 
000374 
000375 
000376 
000377 
000378 
000379 
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backward compatability with earlier versions of the dialog building block} 


{"Standard" elements: } 


FUNCTION TDialog.AddStdButton(itsid: $255; itsXLoc, itsYLoc: LONGINT; sameSizedButton: TButton; 
itsCmdNumber: TCmdNumber): TButton; 


PROCEDURE TDialog. AddOKButton(cmdNumber: TCmdNumber); {OK Button} 


PROCEDURE TDialog.AddCancel Button(cmdNumber: TCmdNumber); {Cancel Button} 
FUNCTION TDialog.AddStdCluster(itsld: $255; itsXLoc, itsYLoc: LONGINT): 


TCluster: 


FUNCTION TDialog.AddStdFreeCheckbox(itsld: $255; itsXLoc, itsYLoc: LONGINT): TCheckBox; 


FUNCTION TDialog.AddStdl nputFrame(itsid: $255; itsXLoc: LONGI NT; 


itsYLoc: LONGINT; maxl nput Chars 


FUNCTION TDialog.AddStdLegend(itsid: $255; itsXLoc, itsYLoc: LONGI NT; 


INTEGER): Tl nput Frame; 


itsTypeStyle: TTypeStyle): TLegend 
FUNCTION TDialog.AddSysLegend(itsid: $255; itsXLoc, itsYLoc: LONGINT): TLegend 


{General creation of dial ogl mages} 


FUNCTION TDialog.AddButton(itsld: $255; itsLocation: LPoint; itsMetrics: 


TButtonMetrics; 


sameSizedButton: TButton; itsCmdNumber: TCmdNumber): TButton; 


FUNCTION TDialog.AddFreeCheckbox(itsID: $255; itsXLoc, itsYLoc: LONGI NT; 


boxWidth: INTEGER; 


boxHei ght: INTEGER; wantLabel: BOOLEAN; label Offset: Point; itsTypeStyle: TTypeStyle): TCheckbox; 


FUNCTION TDialog. AddBi gFreeCheckbox(itsld: $255; itsXLoc, itsYLoc: LONGINT): TCheckbox; 


FUNCTION TDialog. AddRow0f Boxes(itsID: $255; itsXLoc, itsYLoc: LONGINT; 


number Of Boxes: INTEGER; 


starting! DNumber: INTEGER; boxWidth: INTEGER; boxHeight: INTEGER; boxSpacing: INTEGER): TCluster; 


FUNCTION TDialog. Addi nputFrame(itsld: $255; 
promptLocation: LPoint; promptTypeStyle: TTypeStyle 
inputLocation: LPoint; inputTypeStyle: TTypeStyle; 


maxi nputChars: INTEGER; itsBorders: Rect; drawlnputLRect: BOOLEAN 


drawHitLRect: BOOLEAN): TI nputFrame; 


FUNCTION TDialog. DownAt(mouseLPt: LPoint): TDialogl mage; OVERRI DE; 
PROCEDURE TDialog.RecalcExtent; OVERRIDE; 


END; 


TButton = SUBCLASS OF Tl mageWthID 


cmdNumber: TCmdNumber 
mi nWi dth: INTEGER; 
isHighlighted: BOOLEAN 
next SameSi zedButton: TBut ton: 
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000380 legend: TLegend 

000381 buttonMetrics: TButtonMetrics 

000382 

000383 {Creation/ Destruction} 

000384 FUNCTION TButton. CREATE(object: TObject; heap: THeap; itsld: $255; itsView: TView 
000385 itsLocation: LPoint; itsMetrics: TButtonMetrics; sameSizedButton: TButton; 
000386 itsCmdNumber: TCmdNumber): TButton:; 

000387 

000388 PROCEDURE TButton. Draw) ustMe; OVERRIDE; 

000389 PROCEDURE TButton. Hi ghlight(highTransit: THighTransit); 

000390 FUNCTION TButton. LaunchLayoutBox(view: TView): Tl mage; OVERRIDE; 

000391 PROCEDURE TButton. MousePress(mouseLPt: LPoint); OVERRIDE; 

000392 PROCEDURE TButton. MouseRel ease; OVERRIDE; 

000393 PROCEDURE TButton. RecalcExtent; OVERRIDE; 

000394 PROCEDURE TButton. Recompute(minWidth: | NTEGER); 

000395 FUNCTION TButton. Still MyMouse(mouseLPt: LPoint): BOOLEAN; OVERRIDE; 

000396 

000397 END; {TButton interface} 

000398 

UE Ve Co eee eee a er ere ee ee en re ec ec ee ee ete eee er eee 
000400 

000401 TCheckbox = SUBCLASS of Tl mageWthlD 

000402 

000403 isSelected: BOOLEAN 

000404 

000405 rect! mage: TRectl mage; {also a child} 

000406 legend: TLegend; {if nonnil, also a child} 

000407 

000408 FUNCTION TCheckbox. CREATE(object: TObject; heap: THeap; itsld: $255; itsView: TView 
000409 itsLocation: LPoint; boxWidth: INTEGER; boxHei ght: INTEGER; wantLabel: BOOLEAN 
000410 label Offset: Point; itsTypeStyle: TTypeStyle): TCheckbox; 

000411 

000412 PROCEDURE TCheckbox. ChangeLabel (newS255: $255); 

000413 FUNCTION TCheckbox. CursorAt( mouseLPt: LPoint): TCursorNumber; OVERRIDE; 

000414 PROCEDURE TCheckbox. Draw; OVERRI DE; 

000415 FUNCTION TCheckbox. LaunchLayoutBox(view: TView): Tl mage; OVERRI DE; 

000416 PROCEDURE TCheckbox. MousePress(mouseLPt: LPoint); OVERRIDE; 

000417 PROCEDURE TCheckbox. Toggle; 

000418 

000419 END; {TCheckbox interface} 

000420 

O00404:, “Hstectoeecet Mesidssgeseusete sere Centinenietiticn eben b imap ace pane eu oe ee eos Saeed tebe dsateens 
000422 

000423 TCluster = SUBCLASS of Tl mageWithID 

000424 

000425 {children: TList; (of TCheckbox) } 

000426 

000427 location: LPoi nt; {only used for adding the first aligned checkbox} 
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000428 
000429 
000430 
000431 
000432 
000433 
000434 
000435 
000436 
000437 
000438 
000439 
000440 
000441 
000442 
000443 
000444 
000445 
000446 
000447 
000448 
000449 
000450 
000451 
000452 
000453 
000454 
000455 
000456 
000457 
000458 
000459 
000460 
000461 
000462 
000463 
000464 
000465 
000466 
000467 
000468 
000469 
000470 
000471 
000472 
000473 
000474 
000475 


Apple Lisa Computer Technical Information 


hi t Box: TCheckbox; {which one was just successfully queried by Hit} 
hi Lit Box: TCheckbox; {which one is highlighted} 
last Box: TCheckBox; {the checkbox most recently added checkbox} 


FUNCTION TCluster. CREATE(object: TObject; heap: THeap; itsld: $255; itsView: TView 
itsLocation : LPoint): TCluster; 


{****** PUBLIC INTERFACE: 
KEK KKK 


kee*x** Create a cluster using TDialog.NewCluster; add checkboxes to it by calling any of the following 


****** three methods. To change which box is selected in the cluster programmatically, call Select Box 
KKKKKK 


¥ke*x** To find out which box is selected in a cluster, look at cluster. hiLitBox.idNumber} 


FUNCTION TCluster. NewAli gnedCheckbox(itsPhrase: INTEGER; selectThisOne: BOOLEAN): TCheckbox; 
FUNCTION TCluster. NewCheckbox(itsPhrase: INTEGER; boxWidth: INTEGER 


boxHei ght: INTEGER; wantLabel: BOOLEAN; labelOffset: Point; itsTypeStyle: TTypeStyle; 


selectThisOne: BOOLEAN): TCheckbox; 
PROCEDURE TCluster. AddRow0f Boxes(numberOfBoxes: INTEGER; starting! DNumber: | NTEGER; 
boxWidth: INTEGER; boxHeight: INTEGER; boxSpacing: INTEGER); 


PROCEDURE TCluster.SelectBox(checkbox: TCheckbox); {select this box, deselecting others} 
{****** PRIVATE INTERFACE: 
KKKKKK 


**k*** These remaining methods of TCluster are for primarily for internal use: } 


FUNCTION TCluster.AddAlignedCheckbox(itsid: $255; selectThisOne: BOOLEAN): TCheckbox; 
FUNCTION TCluster. AddCheckbox(itsID: $255; itsLocation: LPoint; boxWidth: INTEGER 


boxHei ght: INTEGER; wantLabel: BOOLEAN; labelOffset: Point; itsTypeStyle: TTypeStyle; 


selectThisOne: BOOLEAN): TCheckbox 
FUNCTION TCluster. Hit(mouseLPt: LPoint): BOOLEAN; OVERRI DE; 
PROCEDURE TCluster. MousePress(mouseLPt: LPoint); OVERRIDE; 
FUNCTION TCluster. Still MyMouse(mouseLPt: LPoint): BOOLEAN; OVERRIDE; 


END; {TCluster interface} 


Til nput Frame = SUBCLASS OF Tl mageWthlD 


text Dial og! mage: TTextDi al ogl mage 


prompt: TLegend; 
borders: Rect; 
drawl nputLRect: BOOLEAN; {whether or not to draw a faint box around the input LRect} 
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000476 drawHitLRect: BOOLEAN; {whether or not to frame the hit rectangle} 

000477 maxi nput Chars: INTEGER 

000478 input TypeStyle: TTypeStyle 

000479 

000480 FUNCTION TinputFrame. CREATE(object: TObject; heap: THeap; itsld: $255; itsView: TView 
000481 promptLocation: LPoint; promptTypeStyle: TTypeStyle; 

000482 inputLocation: LPoint; inputTypeStyle: TTypeStyle; maxIlnputChars: INTEGER 
000483 itsBorders: Rect; drawlnputLRect: BOOLEAN; drawHitLRect: BOOLEAN 

000484 ): Tlnput Frame; 

000485 

000486 


000487 { RRR RK KKK KKK KKK KKK AK KKK KKK KKK KAKA KAKKKKEKEK PUBLIC | NTERFACE **¥ **# HHH KKK RRR KK RRR KKK KKK KKK RK KKK KKK } 


000488 


000489 {Create an input frame by calling TDialog. NewlnputFrame; use GetContents and Suppl antContents 
000490 to find out what has been typed, and to change what appears in the typing area} 

000491 

000492 PROCEDURE TinputFrame. GetContents(VAR theStr: $255); {inspect current frame contents} 
000493 PROCEDURE TinputFrame. Suppl antContents(newStr: $255); {change current frame contents} 
000494 


000495 { HRA KKK KKK KR KKK RRA KK RK KKK KKK RAK KKAKKKKEKEK DRIVATE | NTERFACE **% * ¥ # #4 HH HK RRR KK RK RRR KKK KKK RK KKK KKK KK } 


000496 


000497 FUNCTION TinputFrame. CursorAt(mouseLPt: LPoint): TCursorNumber; OVERRIDE; 

000498 PROCEDURE Til nputFrame. Draw; OVERRI DE; 

000499 FUNCTION TinputFrame. LaunchLayoutBox(view: TView): Tl mage; OVERRIDE; 

000500 PROCEDURE Ti nputFrame. MousePress( mouseLPt: LPoint); OVERRIDE; 

000501 PROCEDURE TinputFrame. RecalcExtent; OVERRIDE; 

000502 FUNCTION TinputFrame. Still MyMouse(mouseLPt: LPoint): BOOLEAN; OVERRI DE; 

000503 

000504 END; {Tl nputFrame interface} 

000505 

ODS OG Acca ret cia accra aera aire eas ow a aad als bw ae ahaa inn Se ea er ee oe Cua eee } 
000507 

000508 TLegend = SUBCLASS OF TDi al ogl mage 

000509 

000510 location: LPoint; 

000511 paragraph: TParagraph; 

000512 woul dBeDraggabl e: BOOLEAN; {whether, during layout, it should itself be draggabl e} 
000513 usesSysFont: BOOLEAN; {whether it is in systemfont -- a special case} 
000514 

000515 FUNCTION TLegend. CREATE(object: TObject; heap: THeap; itsChars: $255; itsView: TView 
000516 itsLocation: LPoint; itsTypeStyle: TTypeStyle): TLegend 

000517 PROCEDURE TLegend. Free; OVERRIDE; 

000518 


000519 { HORAK RR KKK KKK KKK RK RRA KK RK KKK KKK RAK KKAKKRKEKERK PUBLIC | NTERFACE **¥ * ¥ ## HHH H RK RK KK RRR KR RRR KK KKK KKK KKK KK } 


000520 


000521 PROCEDURE TLegend. ChangeToPhrase(newPhrase: INTEGER); {for getting new text from phrase file} 
000522 PROCEDURE TLegend. ChangeString(newString: $255); {for getting new text froma string} 
000523 PROCEDURE TLegend. Get String(VAR itsString: $255); {determine current chars residing in the | egend} 
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000524 

000526 PROCEDURE TLegend. Draw; OVERRIDE; 

000527 PROCEDURE TLegend. Get BoxRi ght; {sets extent based on current chars & location} 
000528 FUNCTION TLegend.LaunchLayoutBox(view: TView): Tl mage; OVERRIDE; 

000529 PROCEDURE TLegend. OffsetBy(deltaLPt: LPoint); OVERRIDE; 

000530 PROCEDURE TLegend. RecalcExtent; OVERRIDE; 

000531 

000532 END; 

000533 

000534 {cece ence eee eee eee eee classes i mp] ement ed in file UDi al og3 TCT ee Cee ee eC EC eee Tee ee eee } 
000535 

000536 

000537 


000538 TPicObject = SUBCLASS OF Tl mageWthID {An Object which holds a QD Picture File} {CAUTION: totally untested} 
000539 


000540 picture: Pi cHandle: 

000541 boxAtCreation: Rect; {need to get itsView parameter into all these guys} 
000542 

000543 FUNCTION TPicObj ect. CREATE(object: TObject; heap: THeap; itsIld: $255; 

000544 itsView: TView; itsLocation: LPoint; itsPicHandle: PicHandle): TPicObj ect; 
000545 PROCEDURE TPicObject. Free; OVERRIDE; 

000546 

000547 PROCEDURE TPicObject. Draw; OVERRI DE; 

000548 

000549 END; 

000550 

Ue eer ee te ee ta ener err toy Tener rer rT er tree eT ere eer ee or eee ee ee eee er er re } 
000552 

000553 TRectl mage = SUBCLASS OF TDialogl mage {a rectangle packaged as a object} 

000554 

000555 penState: PenState 

000556 

000557 FUNCTION TRect! mage. CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsld: $255; 
000558 itsView: TView; itsPenState: PenState; withChildren: BOOLEAN): TRectl mage 
000559 

000560 PROCEDURE TRectl mage. Draw; OVERRIDE; 

000561 FUNCTION TRect!l mage. LaunchLayout Box(view: TView): Tlmage; OVERRIDE; 

000562 END; 

000563 

i oe ee ee ee ee ee ee eee ee ee ee ee ee ey er es } 
000565 

000566 

000567 TTextDialogl mage = SUBCLASS OF Tl mageWthlD 

000568 

000569 textl mage: TTextl mage 

000570 wouldBeDraggable: BOOLEAN 

000571 ref Count: INTEGER 
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000572 

000573 FUNCTION TTextDialogl mage. CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsld: $255; 
000574 itsView: TView; itsTypeStyle: TTypeStyle 

000575 itslnitial Chars: $255): TText Dial ogl mage 

000576 PROCEDURE TTextDialogl mage. Free; OVERRIDE; 

000577 

000578 PROCEDURE TTextDi al ogl mage. ChangeRefCountBy(delta: | NTEGER); 

000579 FUNCTION TTextDialogl mage. CursorAt(mouseLPt: LPoint): TCursorNumber; OVERRI DE; 

000580 PROCEDURE TText Di al ogl mage. Draw; OVERRIDE; 

000581 FUNCTION TTextDialogl mage. LaunchLayoutBox(view: TView): Tlmage; OVERRIDE; 

000582 PROCEDURE TTextDi al ogl mage. MousePress(mouseLPt: LPoint); OVERRIDE; 

000583 PROCEDURE TText Dial ogl mage. Offset By(deltaLPt: LPoint); OVERRIDE; 

000584 END; 

000585 

i ie Cee ee ee ee ere er ee ere ere cre ee ce er eer en cee } 
000587 


000588 TFrameSelection = SUBCLASS OF TSelection {the phony selection covering TextSelection in an input frame} 
000589 


000590 inputFrame: TlnputFrame; {the input frame in which the selection occurs} 

000591 

000592 FUNCTION TFrameSelection. CREATE(object: TObject; heap: THeap; itsInputFrame: Tl nput Frame) 
000593 : TFrameSel ection: 

000594 

000595 FUNCTION TFrameSel ection. CanDoCommand(cmdNumber: TCmdNumber; VAR checklt: BOOLEAN): BOOLEAN; OVERRIDE; 
000596 PROCEDURE TFrameSel ection. KeyChar(ch: CHAR); OVERRI DE; 

000597 PROCEDURE TFrameSelection.KeyEnter(dh, dv: INTEGER); OVERRIDE; 

000598 PROCEDURE TFrameSel ection. KeyReturn; OVERRI DE; 

000599 PROCEDURE TFrameSel ection. KeyTab(f Backward: BOOLEAN); OVERRIDE; 

000600 PROCEDURE TFrameSel ection. MousePress(mouseLPt: LPoint); OVERRIDE; 

000601 PROCEDURE TFrameSel ection. PerformCommand( command: TCommand; cmdPhase: TCmdPhase); OVERRIDE; 
000602 PROCEDURE TFrameSel ection. Restore; OVERRI DE; 

000603 

000604 END; {TFrameSelection interface} 

000605 

000606 


000607 TPlannerView = SUBCLASS OF TDialogView {a view within which images are laid out} 
000608 
000609 {Variables} 


000610 

000611 vi ewBei ngPl anned: TVi ew 

000612 

000613 all owSket ching: BOOLEAN; {for internal use of the layout mechani sm} 

000614 retainPickedBox: BOOLEAN 

000615 currentLayout Box: TLayout Box; 

000616 

000617 {Creation/ Destruction} 

000618 FUNCTION TPlannerView. CREATE(object: TObject; heap: THeap; itsViewBeingPlanned: TView 

000619 itsPanel: TPanel; itsAllowSketching: BOOLEAN; itsRetainPickedBox: BOOLEAN): TPlannerVi ew 
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000620 
000621 
000622 
000623 
000624 
000625 
000626 
000627 
000628 
000629 
000630 
000631 
000632 
000633 
000634 
000635 
000636 
000637 
000638 


000640 
000641 
000642 
000643 
000644 
000645 
000646 
000647 
000648 
000649 
000650 
000651 
000652 
000653 
000654 
000655 
000656 
000657 
000658 
000659 
000660 
000661 
000662 
000663 
000664 
000665 
000666 
000667 
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PROCEDURE TPlannerView. Init(itsListOfl mages: TList); 
FUNCTION TPlannerView. NewLayoutBox(image: Tlmage): TLayoutBox; {return NIL if element not to be shown} 


PROCEDURE TPlannerView. Free; OVERRIDE; 


{Display} 
PROCEDURE TPlannerView. Draw; OVERRIDE; 


{Mouse Tracking} 
FUNCTION TPlannerView. CursorAt(mouseLPt: LPoint): TCursorNumber; OVERRIDE; 
PROCEDURE TPlannerView. MouseMove(mouseLPt: LPoint); OVERRI DE; 
PROCEDURE TPlannerView. MousePress(mouseLPt: LPoint); OVERRIDE; 
PROCEDURE TPlannerView. MouseRel ease; OVERRI DE; 


{Enumeration of components} 
PROCEDURE TPlannerView. EachActual Part( PROCEDURE DoToObject(filteredObj: TObject)); OVERRIDE; 


END; 


TLayoutBox = SUBCLASS OF TI mageWithID 


{Variables} 
mani pul ee: Tl mage 
titleTab: TTitleTab; 


suppressDrawi ngMani pul ee: BOOLEAN 


isResizable: BOOLEAN; 

borders: Rect; 

woul dMakeSel ection: BOOLEAN; {client must directly set if not wanting default 'FALSE' } 
isDraggable: BOOLEAN; 

shoul dFrame: BOOLEAN; 

hasDraggee: BOOLEAN; 


{Creation/ Destruction} 

FUNCTION TLayoutBox. CREATE(object: TObject; heap: THeap; baseExtent: LRect; itsID: $255; 
itsParent: TLayoutBox; itsView: TView; itsManipulee: Tlmage; itsBorders: Rect; 
itsResizable: BOOLEAN; itsSuppression: BOOLEAN; withChildren: BOOLEAN): TLayout Box; 

PROCEDURE TLayoutBox. Free; OVERRIDE; 


{Change and Display} 


PROCEDURE TLayoutBox. ChangeDragState(enteringDrag: BOOLEAN) 
PROCEDURE TLayout Box. ConsiderMouse(mouseLPt: LPoint; VAR madeSelection: BOOLEAN; 
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000668 VAR pickedLayoutBox: TLayoutBox); DEFAULT; 

000669 FUNCTION TLayoutBox. CursorAt(mouseLPt: LPoint): TCursorNumber; OVERRI DE; 

000670 PROCEDURE TLayoutBox. Draw; OVERRIDE; 

000671 PROCEDURE TLayoutBox. Draw) ustMe; OVERRI DE; 

000672 PROCEDURE TLayout Box. FreeMani pul ee 

000673 PROCEDURE TLayout Box. Highlight(highTransit: THighTransit); 

000674 PROCEDURE TLayout Box. MousePress(mouseLPT: LPoint); OVERRIDE; 

000675 PROCEDURE TLayout Box. Move(deltaLPt: LPoint); DEFAULT; 

000676 FUNCTION TLayoutBox. NoTitleTab( heap: THeap): TTitleTab; 

000677 PROCEDURE TLayout Box. OffsetBy(deltaLPt: LPoint); OVERRIDE; 

000678 PROCEDURE TLayout Box. OffsetLayout BoxBy(deltaLPt: LPoint; textl mageAsWell: BOOLEAN); DEFAULT; 
000679 PROCEDURE TLayout Box. RecalcExtent; OVERRIDE; 

000680 PROCEDURE TLayout Box. Resize(newExtent: LRect); OVERRIDE; 

000681 PROCEDURE TLayout Box. TabGrabbed; DEFAULT; 

000682 

000683 END; 

000684 

000685 TLegendLayoutBox = SUBCLASS OF TLayoutBox {manipulee is a TLegend} 

000686 

000687 textDialogl mage: TTextDialogl mage 

000688 

000689 {Creation/Destructi on} 

000690 FUNCTION TLegendLayout Box. CREATE(object: TObject; heap: THeap; itsView: TView; itsLegend: TLegend 
000691 ): TLegendLayout Box; 

000692 

000693 FUNCTION TLegendLayout Box. CursorAt( mouseLPt: LPoint): TCursorNumber; OVERRI DE; 

000694 PROCEDURE TLegendLayout Box. Draw; OVERRIDE; 

000695 PROCEDURE TLegendLayout Box. Offset By(deltaLPt: LPoint); OVERRIDE; 

000696 PROCEDURE TLegendLayout Box. OffsetLayoutBoxBy(deltaLPt: LPoint; text! mageAsWell: BOOLEAN); OVERRIDE; 
000697 {use of the second argument is strange and non self-explanatory; comments in the internal 
000698 documentation may help. Nobody should be calling this old boy from outside, anyway} 
000699 PROCEDURE TLegendLayout Box. MousePress(mouseLPT: LPoint); OVERRIDE; 

000700 PROCEDURE TLegendLayout Box. RecalcExtent; OVERRI DE; 

000701 

000702 END; 

000703 

000704 

000705 TButtonLayoutBox = SUBCLASS OF TLayoutBox {manipulee is a TButton} 

000706 

000707 {Variables} 

000708 next SameSi zedBox: TButt onLayout Box; 

000709 ol dLegendTopLeft: LPoi nt; 

000710 

000711 {Creation/ Destruction} 

000712 FUNCTION TButtonLayout Box. CREATE(object: TObject; heap: THeap; itsButton: TButton; 
000713 itsView: TView): TButtonLayout Box; 

000714 

000715 {Other Methods} 
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000716 
000717 
000718 
000719 
000720 
000721 
000722 
000723 
000724 
000725 
000726 
000727 
000728 
000729 
000730 
000731 
000732 
000733 
000734 
000735 
000736 
000737 
000738 
000739 
000740 
000741 
000742 
000743 
000744 
000745 
000746 
000747 
000748 
000749 
000750 
000751 
000752 
000753 
000754 
000755 
000756 
000757 
000758 
000759 
000760 
000761 
000762 
000763 


PROCEDURE 


FUNCTI ON 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


END; 


TTitleTab = § 


| ayout Box 
legend: 
shoul dDra 


FUNCTION TTitleTab. CREATE(object: TObject; heap: THeap; 


itsCa 
PROCEDURE 


PROCEDURE 


Apple 


Lisa Computer Technical Information 


TButtonLayout Box. 


TButtonLayout Box. 
TButtonLayout Box. 
TButtonLayout Box. 
TButtonLayout Box. 
TButtonLayout Box. 


UBCLASS OF TI mage 


: TLayout 
TLegend 
wlegend: 


ption: $255): TTit 


TTitleTab. Free 


TTitleTab. Draw 


BOOLEAN; 


ConsiderMouse(mouseLPt: LPoint; VAR madeSel ection 

VAR pickedLayoutBox: TLayout Box); OVERRIDE; 
CursorAt(mouseLPt: LPoint): TCursorNumber; OVERRIDE; 
Draw) ustMe; OVERRIDE; 
OffsetBy(deltaLPt: LPoint); 
RecalcExtent; OVERRIDE; 
Recalc) ust Me; 


BOOLEAN; 


OVERRI DE; 


Box; 
{FALSE if string is too wide to fit} 
itsLayoutBox: TLayout Box; 


itsHei ght: INTEGER; 


leTab: 


OVERRI DE; 
OVERRI DE; 


PROCEDURE TTitleTab. OffsetBy(deltaLPt: LPoint); OVERRIDE; 


PROCEDURE TTitl eTab. Resi ze(newExtent: 


END; 


LRect); OVERRIDE; 


TLayPickSelection = SUBCLASS OF TSelection 


{Variables} 
| ayout Box 


FUNCTI ON 


FUNCTI ON 


PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


END; 


: TLayout Box; 


TLayPickSelection 
itsKind: | 


TLayPickSelection 


TLayPickSel ection, 
TLayPickSel ection, 
TLayPickSel ection, 
TLayPickSel ection. 
TLayPickSel ection, 
TLayPickSel ection, 


-CREATE(object: TObject; heap: THeap; itsView: TPlannerVi ew 


TLayMoveCmd = SUBCLASS OF TCommand 


Apple Lisa To 


NTEGER; itsLayoutBox: TLayoutBox; itsAnchorLPt: LPoint): TLayPickSel ection; 
.CanDoCommand(cmdNumber: TCmdNumber: VAR checklt: BOOLEAN) 
BOOLEAN; OVERRI DE; 

Deselect; OVERRIDE; 

Hi ghlight(highTransit: THighTransit); OVERRI DE; 

KeyClear; OVERRIDE; 

MouseMove(mouseLPt: LPoint); OVERRIDE; 

MouseRel ease; OVERRI DE; 

Restore; OVERRIDE; 
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000764 

000765 {Variables} 

000766 layoutBox: TLayout Box; 

000767 

000768 hOffset: LONGI NT; 

000769 vOffset: LONGI NT; 

000770 

000771 {Creation} 

000772 FUNCTION TLayMoveCmd. CREATE(object: TObject; heap: THeap; itsLayoutBox: TLayout Box; 
000773 itsHOffset, itsVOffset: LONGINT): TLayMoveCmd; 

000774 

000775 {Command Execution} 

000776 PROCEDURE TLayMoveCmd. Perform(cmdPhase: TCmdPhase); OVERRI DE; 

000777 

000778 END; 

000779 

000780 TEditLegendSelection = SUBCLASS OF TSelection 

000781 

000782 {Variables} 

000783 legendLayout Box: TLegendLayout Box 

000784 hostLegend: TLegend 

000785 textDialogl mage: TTextDialogl mage 

000786 SuppressHost: BOOLEAN 

000787 tripleClick: BOOLEAN; {+SW+} 

000788 

000789 {Creation/ Destruction} 

000790 FUNCTION TEditLegendSel ection. CREATE(object: TObject; heap: THeap; itsLegendLayout Box 
000791 TLegendLayoutBox; itsAnchorLPt: LPoint): TEditLegendSel ection; 
000792 FUNCTION TEditLegendSelection.Clone( heap: THeap): TObject; OVERRIDE; 

000793 PROCEDURE TEditLegendSelection. Deselect; OVERRIDE; 

000794 PROCEDURE TEditLegendSelection. Free; OVERRIDE; 

000795 

000796 {Udders} 

000797 FUNCTION TEditLegendSel ection. CanDoCommand(cmdNumber: TCmdNumber; VAR checklt: BOOLEAN) 
000798 : BOOLEAN; OVERRI DE; 

000799 PROCEDURE TEditLegendSel ection. KeyBack(f Word: BOOLEAN); OVERRIDE; 

000800 PROCEDURE TEditLegendSel ection. KeyChar(ch: CHAR); OVERRIDE; 

000801 PROCEDURE TEditLegendSelection. KeyEnter(dh, dv: INTEGER); OVERRIDE; 

000802 PROCEDURE TEditLegendSel ection. KeyReturn; OVERRI DE; 

000803 PROCEDURE TEditLegendSel ection. MouseMove(mouseLPt: LPoint); OVERRIDE; {+SW+} 

000804 PROCEDURE TEditLegendSel ection. MousePress(mouseLPt: LPoint); OVERRIDE; {+SW+} 

000805 PROCEDURE TEditLegendSel ection. MouseRelease; OVERRIDE; {+SW+} 

000806 FUNCTION TEditLegendSel ection. NewCommand(cmdNumber: TCmdNumber): TCommand; OVERRIDE; 
000807 PROCEDURE TEditLegendSel ection. PerformCommand(command: TCommand; cmdPhase: TCmdPhase); OVERRIDE; 
000808 PROCEDURE TEditLegendSelection. Restore; OVERRI DE; 

000809 PROCEDURE TEditLegendSel ection. Reveal (asMuchAsPossi ble: BOOLEAN); OVERRIDE; 

000810 

000811 END; 
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000812 
000813 
000814 
000815 
000816 
000817 
000818 
000819 
000820 
000821 
000822 
000823 
000824 
000825 
000826 
000827 
000828 
000829 
000830 
000831 
000832 
000833 
000834 
000835 
000836 
000837 
000838 
000839 
000840 
000841 
000842 
000843 
000844 
000845 
000846 
000847 
000848 
000849 
000850 
000851 
000852 
000853 
000854 
000855 
000856 
000857 
000858 
000859 
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TDi al ogDesi gnWi ndow = SUBCLASS OF TDi al ogWndow 


host Window: TWi ndow; 
host Di al ogVi ew: TDi al ogVi ew 
fromDi al ogBox: BOOLEAN 


FUNCTION TDialogDesignWindow. CREATE(object: TObject; heap: THeap; 
itsHostDialogView: TDialogView): TDial ogDesi gnWi ndow 


FUNCTION TDi al ogDesi gnWi ndow. CanDoCommand(cmdNumber: TCmdNumber; VAR checkit: BOOLEAN) 
BOOLEAN; OVERRI DE; 

FUNCTION TDial ogDesi gnWi ndow. NewCommand(cmdNumber: TCmdNumber): TCommand; OVERRI DE; 

PROCEDURE TDi al ogDesi gnWi ndow. Rel i nqui shControl 

PROCEDURE TDi al ogDesi gnWi ndow. Resize( moving: BOOLEAN); OVERRIDE; 

PROCEDURE TDi al ogDesi gnWi ndow. Sei zeControl 


END; 


TStdPrintManager = SUBCLASS OF TPrintManager 
FUNCTION TStdPrint Manager. CREATE(object: TObject; heap: THeap): TStdPrint Manager 
PROCEDURE TStdPrint Manager. EnterPageEditting; OVERRI DE; 
PROCEDURE TStdPrint Manager. I nit(itsMainView: TView; itsDfltMargins: LRect); OVERRI DE; 
PROCEDURE TStdPrint Manager. ReactToPrinterChange; OVERRI DE; 
PROCEDURE TStdPrintManager. SetDfltHeadings; OVERRIDE; 
END; 

TLegendHeading = SUBCLASS OF THeadi ng 


masterLegend: TLegend; 
currentLegend: TLegend 


topToBaseline: INTEGER; {offset from box top to baseline} 
borders: Rect; {size by which box exceeds legend's extent} 


{Creation/ Destruction} 
FUNCTION TLegendHeading. CREATE(object: TObject; heap: THeap; itsPrintManager: TPrintManager 
itsString: $255; itsTypeStyle: TTypeStyle; 
itsPageAlignment: TPageAlignment; itsOffsetFromAlignment: LPoint; 
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000860 itsBorders: Rect): TLegendHeadi ng 

000861 PROCEDURE TLegendHeading. Free; OVERRI DE; 

000862 

000863 {Nyi ngi ne} 

000864 PROCEDURE TLegendHeadi ng. Adj ustForPage(pageNumber: LONGINT; editing: BOOLEAN); OVERRIDE; 
000865 PROCEDURE TLegendHeadi ng. Draw; OVERRI DE; 

000866 FUNCTION TLegendHeadi ng. LaunchLayoutBox(view: TView): Tl mage; OVERRI DE; 

000867 PROCEDURE TLegendHeadi ng. Offset By(deltaLPt: LPoint); OVERRIDE; 

000868 PROCEDURE TLegendHeadi ng. RecalcExtent; OVERRI DE; 

000869 FUNCTION TLegendHeading. ShouldFrame: BOOLEAN; OVERRIDE; 

000870 

000871 END; 

000872 

000873 

000874 TPageDesignWindow = SUBCLASS OF TDi al ogW ndow 

000875 

000876 host Vi ew: TView; {the view whose pages are being designed in this dialog} 
000877 layout Panel: TPanel; {my control Panel is the status panel } 

000878 

000879 FUNCTION TPageDesi gnWindow. CREATE(object: TObject; heap: THeap; itsHostView: TView): TPageDesi gnWi ndow 
000880 

000881 PROCEDURE TPageDesignWindow. Disappear; OVERRIDE; 

000882 FUNCTION TPageDesi gnWindow. NewCommand(cmdNumber: TCmdNumber): TCommand; OVERRIDE; 
000883 

000884 END; 

000885 

000886 

000887 TPagePlannerView = SUBCLASS OF TPlanner View 

000888 

000889 FUNCTION TPagePl annerView. CREATE( object: TObject; heap: THeap; itsPrintManager: TPrint Manager 
000890 itsPanel: TPanel): TPagePlanner Vi ew 

000891 

000892 PROCEDURE TPagePl anner View. Draw; OVERRIDE; 

000893 

000894 END; 

000895 

000896 

000897 TPageStatusDialog = SUBCLASS OF TDialog 

000898 

000899 currentHeadi ng: THeadi ng; 

000900 

000901 oddEvenCluster: TCluster 

000902 mi nPageFrame: Tl nput Frame; 

000903 maxPageFrame: Tl nput Frame; 

000904 alignCluster: TCluster 

000905 unitsCluster: TCluster 

000906 marginTitle: TLegend 

000907 
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000908 leftCluster: TCluster 

000909 topCluster: TCluster 

000910 rightCluster: TCluster 

000911 bottomCl uster: TCluster 

000912 

000913 {Creation/ Destruction} 

000914 FUNCTION TPageStatusDialog. CREATE( object: TObject; heap: THeap; itsPanel: TPanel): TPageStatusDial og 
000915 

000916 {Sonst} 

000917 PROCEDURE TPageStatusDi al og. ButtonPushed( button: TButton); OVERRIDE; 

000918 PROCEDURE TPageStatusDi al og. CheckboxHit(checkbox: TCheckbox; toggleDirection: BOOLEAN); OVERRIDE; 
000919 FUNCTION TPageStatusDialog. DownAt( mouseLPt: LPoint): TDialogl mage; OVERRIDE; 

000920 PROCEDURE TPageStatusDialog. Draw; OVERRI DE; 

000921 PROCEDURE TPageStatusDialog.InspectHeadingParms(VAR oddOnly, evenOnly: BOOLEAN 

000922 VAR pageAlignment: TPageAlignment; VAR minPage, maxPage: LONGI NT) 
000923 PROCEDURE TPageStatusDialog. SetHeadingParms(oddOnly, evenOnly: BOOLEAN 

000924 pageAlignment: TPageAlignment; minPage, maxPage: LONGI NT) 
000925 END; 

000926 

000927 

000928 TPageLayoutBox = SUBCLASS OF TLayout Box 

000929 

000930 

000931 {Creation/ Destruction} 

000932 FUNCTION TPageLayout Box. CREATE(object: TObject; heap: THeap; itsView: TView; itsHeading: THeading 
000933 itsResizable: BOOLEAN): TPageLayout Box; 

000934 

000935 PROCEDURE TPageLayout Box. FreeMani pulee; OVERRI DE; 

000936 PROCEDURE TPageLayout Box. TabGrabbed; OVERRI DE; 

000937 END; 

000938 

000939 

000940 TLgHdngLayoutBox = SUBCLASS OF TPageLayout Box 

000941 

000942 legendLayoutBox: TLegendLayout Box; 

000943 

000944 FUNCTION TLgHdngLayout Box. CREATE(object: TObject; heap: THeap; itsView: TView 

000945 itsLegendHeading: TLegendHeading): TLgHdngLayout Box; 

000946 

000947 FUNCTION TLgHdngLayout Box. CursorAt(mouseLPt: LPoint): TCursorNumber; OVERRI DE; 

000948 PROCEDURE TLgHdngLayout Box. Draw; OVERRIDE; 

000949 PROCEDURE TLgHdngLayout Box. MousePress(mouseLPT: LPoint); OVERRI DE; 

000950 PROCEDURE TLgHdngLayout Box. Move(deltaLPt: LPoint); OVERRIDE; 

000951 PROCEDURE TLgHdngLayout Box. RecalcExtent; OVERRI DE; 

000952 

000953 END; 

000954 

000955 
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000956 VAR 

000957 stdFrameBorders: Rect; {extra space around an input-frame and its text} 

000958 stdHdngBorders: Rect; {extra space around a standard heading} 

000959 stdHdngTypeStyle: TTypeStyle; {tile 12 monospaced, normal faces, for titles} 

000960 stdl DBorders: Rect; {a title tab with string, and a small border on the other 3 sides} 
000961 stdi nputTypeStyle: TTypeStyle; {std input font/faces} 

000962 stdFrmeOffset: Poi nt; {std distance between input frame's prompt and input rect} 
000963 stdLabel Offset: Poi nt; {offset fromtop-left corner of a checkbox to leftmost pt of 
000964 baseline of label} 

000965 stdPl ainBorders: Rect; {a slimcaptionless title tab, and a small border on the other 
000966 3 sides} 

000967 stdThinBorders: Rect; {a slimcaptionless title tab above; no other borders} 
000968 titleTypeStyle: TTypeStyle; {tile 15 monospaced, for titles of layout boxes} 

000969 {NB: All the above are initialized in the creation block of TDi al ogWi ndow} 

000970 

000971 stdButtonMetrics: TButtonMetrics; {reinitialized in TDialog. CREATE each ti me} 

000972 

000973 

000974 {Unit-Global Procedures} 

000975 

000976 FUNCTION NewStdDialogWindow heap: THeap; itsHeight: INTEGER; itsKeyResponse, itsMenuResponse 

000977 itsDownl nMai nWi ndowResponse: TDiResponse): TDial ogWi ndow 

000978 {sets up a standard, nonresizable, dialogWndow, and installs a single Panel into it, into 
000979 which it installs a single Dial ogVi ew} 

000980 

000981 FUNCTION NewStdLegend( heap: THeap; itsChars: $255; itsXLoc, itsYLoc: LONGINT; itsView: TView 

000982 itsTypeStyle: TTypeStyle): TLegend; 

000983 


000984 FUNCTION NewSysLegend( heap: THeap; itsChars: $255; itsXLoc, itsYLoc: LONGINT; itsView: TView): TLegend 
100886 PROCEDURE SetParaExtent(paragraph: TParagraph; view: TView; location: LPoint; VAR extentLRect: LRect); 
ntees PROCEDURE LRectAddBorders(baseLRect: LRect; borders: Rect; VAR resultLRect: LRect); 

sas PROCEDURE GetTextAndLocation(phraseNumber: INTEGER; VAR itsChars: $255; VAR itsLocation: LPoint); 


000992 

000993 | MPLEMENTATI ON 

000994 

000995 LI BTK/ UDi al og2} {dialogs} 


{$l 
000996 {$1 LIBTK/ UDi al 0g3} {layout } 
000997 {$1 LIBTK/ UDi al og4} {page margins} 
000998 
001000 {$1 UDial og2} {dialogs} 
001001 {$1 UDi al og3} {layout } 
001002 {$1 UDi al og4} {page margins} 
001003 HARK KKK KKK) 
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001004 
001005 END. {unit UDial og} 
001006 


End of File -- Lines: 1006 Characters: 43015 
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000001 (* Copyright 1984 by Apple Computer, Inc 

000002 

000003 UDialog2 

000004 

000005 TDialogWndow -- TDialogView -- TDialogl mage -- TlmageWithID -- TDialog 
000006 TButton -- TCheckbox -- TCluster -- TlnputFrame -- TLegend 

000007 

000008 *) 

000009 

000010 {04/23/84 1210 SetParaExtent uses thePad rather than view's screenPad if amPrinting} 
000011 {04/23/84 1210 Removed all references to ‘'underEdit' field of TDialogl mage} 
000012 {04/15/84 2345 Spring Release latest} 

000013 {04/04/84 2300 Spring Prelim Rel ease} 

000014 {01/29/84 1750 RELEASE TK8D} 

000015 {12/22/83 1927 RELEASE TK8A} 


000016 

000017 {$l FC fRngABC} 

000018 {$R+} 

000019 {$ELSEC} 

000020 {$R-} 

000021 {$ENDC} 

000022 

000023 {$l FC fSymABC} 

000024 {$D+} 

000025 {$ELSEC} 

000026 {$D-} 

000027 {$ENDC} 

000028 

000029 VAR copyRight: STRING[45] 
000030 

Q0003) Aeveutetatue rates ete eceehiceei Vesa hee iete ede e ice atte cane gee nee edna aed ties ear 
000032 


000033 {$8 DI gAlloc} 
000034 PROCEDURE GetTextAndLocation(phraseNumber: INTEGER; VAR itsChars: $255; VAR itsLocation: LPoint); 
000035 VAR rawPhrase: $255; 


000036 restOflt: $255; 

000037 morsel: $255; 

000038 semiColon: INTEGER 

000039 comma: INTEGER; 

000040 aLocation: LPoint; 

000041 FUNCTION OKI ntegerValue(Str: $255; VAR itsValue: LONGINT): BOOLEAN 
000042 VAR result: TConvResult; 

000043 BEGIN 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 
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StrToLInt(@str, itsValue, result); 
OkI ntegerValue := (result = cvValid); 
END; 
BEGIN {Someone please optimize this someday} 
{$1 FC fTrace}BP(11); {$ENDC} 
process. GetAlert(phraseNumber, rawPhrase); 
semi Colon := POS('@',rawPhrase) 
IF semiColon = 0 THEN 
semi Colon := LENGTH(rawPhrase) + 1; 
itsChars := COPY(rawPhrase, 1, semiColon - 1) 
restOflt := COPY(rawPhrase, semiColon + 1, LENGTH(rawPhrase) - semi Col on) 


comma := POS( ',', restOflt); 
morsel := COPY(restOflt, 1, comma - 1); 
IF OKI ntegerValue(morsel, alLocation.h) THEN 
BEGIN 
morsel := COPY(restOflt, comma + 1, LENGTH(restOflt) - comma); 
IF NOT OKI ntegerValue( morsel, aLocation.v) THEN 
aLocation.v := 100 
END 
ELSE 


SetLPt(aLocation, 100, 100); 


itsLocation := aLocati on: 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$8 TK2Start} 
PROCEDURE LRectAddBorders(baseLRect: LRect; borders: Rect; VAR resultLRect: LRect); 


BEGIN 

{$1 FC fTrace}BP(11); {$ENDC} 

resultLRect.left := baseLRect.left + borders. left; 
resultLRect.top := baseLRect.top + borders. top; 
resultLRect.right := baseLRect.right + borders. right; 
resultLRect.bottom:= baseLRect. bottom + borders. bottom 
{$1 FC fTrace}EP; {$ENDC} 

END; 


{$$ TK2Start} 
{"temporary" implementation, slow, unwieldy} 
PROCEDURE SetParaExtent(paragraph: TParagraph; view: TView; location: LPoint; VAR extentLRect: LRect); 


VAR extent: Rect; 

| Extent: LRect; 

pad: TPad; {+SW+} 
BEGIN 


{$I FC fTrace}BP( 11); {$ENDC} 
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000092 
000093 
000094 
000095 
000096 
000097 
000098 
000099 
000100 
000101 
000102 
000103 
000104 
000105 
000106 
000107 
000108 
000109 
000110 
000111 
000112 
000113 
000114 
000115 
000116 
000117 
000118 
000119 
000120 
000121 
000122 
000123 
000124 
000125 
000126 
000127 
000128 
000129 
000130 
000131 
000132 
000133 
000134 
000135 
000136 
000137 
000138 
000139 


{$$ 


Apple Lisa Computer Technical Information 


paragraph, BuildExtentLRect(zeroLPt, |Extent); {assumes grafPort device is SCREEN for textWdth} 


noPad. LRectToRect(|Extent, extent); 
view. screenPad. RectToLRect(extent, extentLRect); *) 
IF amPrinting THEN 
pad := thePad 
ELSE 
pad := view. screenPad 
pad. RectToLRect(extent, extentLRect); {+S W+} 
OffsetLRect(extentLRect, location. h, location.v); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


DI gAl | oc} 


FUNCTION NewStdDialogWindow(heap: THeap; itsHeight: INTEGER; itsKeyResponse 


{$8 


itsMenuResponse, itsDownl nMainWindowResponse: TDi Response): TDialogWindow 
VAR dial ogWi ndow: TDi al ogWi ndow 


panel: TPanel: 

di al ogVi ew: TDi al ogVi ew 

extentLRect: LRect; 
BEGIN 


{$IFC fTrace}BP(11); {$ENDC} 

di alogWindow := TDialogWindow. CREATE(NIL, heap, FALSE {not resizable}, itsHei ght, 
itsKeyResponse, itsMenuResponse, itsDownl nMai nWi ndowResponse) 

panel := TPanel. CREATE(NIL, heap, dialogWindow, 0, screenBits.bounds.right, [], []); 

di alogWindow. control Panel := panel 


SetLRect(extentLRect, 0, 0, screenBits.bounds.right, screenBits. bounds. bottom ~- 40) 
dialogView := TDialogView. CREATE(NIL, heap, extentLRect, panel, NIL, screenRes); 
di al ogWindow. dial ogView := dial ogView 
NewStdDialogWindow := dialogWindow 
{$I1FC fTrace}EP; {$ENDC} 
END; 


DI gAl | oc} 


FUNCTION NewSysLegend(heap: THeap; itsChars: $255; itsXLoc, itsYLoc: LONGINT; itsView: TView): 


BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
NewSysLegend := NewStdLegend(heap, itsChars, itsXLoc, itsYLoc, itsView, sysTypeStyle); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


DI gAl | oc} 
FUNCTION NewStdLegend(heap: THeap; itsChars: $255; itsXLoc, itsYLoc: LONGINT; itsView: TView 
itsTypeStyle: TTypeStyle): TLegend 
VAR itsString: $255; 
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TLegend; 


000140 
000141 
000142 
000143 
000144 
000145 
000146 
000147 
000148 
000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
000158 
000159 
000160 
000161 
000162 
000163 
000164 
000165 
000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 
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itsLocation: LPoint; 
BEGI N 
{$I1FC fTrace}BP(11); {$ENDC} 
SetLPt(itsLocation, itsXLoc, itsYLoc); {=} 
NewStdLegend := TLegend. CREATE(NIL, heap, itsChars, itsView, itsLocation, itsTypeStyle) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


METHODS OF TDi al ogWi ndow 


{$$ 


DI gAl | oc} 


FUNCTION TDialogWindow. CREATE(object: TObject; heap: THeap; itsResizability: BOOLEAN; itsHeight: INTEGER 


itsKeyResponse, itsMenuResponse, itsDownl nMainW ndowResponse: TDiResponse): TDi al ogWi ndow 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TDi al ogWi ndow( TDi al ogBox. CREATE(object, heap, itsResizability, itsHeight, itsKeyResponse 
itsMenuResponse, itsDownl nMai nWi ndowResponse) } 


SELF.control Panel := 

SELF. dialogView := N 

SELF. mainDialog := N 

{$I1FC fTrace}EP; {$EN 
END; 


SELF.selectPanel; {If not holding a TDialogView, client must reset} 
IL; 
IL; 
DC} 


{$1 FC fDebugMet hods} 


{$$ 


DI gDbg} 


PROCEDURE TDi al ogWi ndow. Fields( PROCEDURE Field(nameAndType: $255)) 


BEGI 


END; 


N 

SUPERSELF. Fields( Field); 
Field('control Panel: TPanel'); 
Field('dialogView: TDi alogView' ) 
Field('mainDialog: TDialog'); 
Field(''); 


{$ENDC} 


{$S 


DI gHot } 


PROCEDURE TDi al ogWi ndow. Appear 


PROCEDURE Tell YourView( obj: TObj ect); 
PROCEDURE YouPrepare(obj: TObj ect); 
BEGIN 


Apple Lisa ToolKit 3.0 Source Code Listing -- 371 of 1012 


000188 
000189 
000190 
000191 
000192 
000193 
000194 
000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
000210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
000228 
000229 
000230 
000231 
000232 
000233 
000234 
000235 


Apple Lisa Computer Technical Information 


TDi al ogl mage( obj). PrepareToAppear 
END; 
BEGIN 
IF InClass(TPanel(obj).view, TDialogView) THEN 
TDi al ogVi ew( TPanel (obj). view). EachActual Part(YouPrepare) ; 
END; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SUPERSELF. Appear; 
SELF. panels. Each( Tell YourVi ew); 
{$1 FC fTrace}EP; {$ENDC} 


END; 
{$$ DI gHot} 
PROCEDURE TDi al ogWi ndow. BeDi smi ssed 
VAR dial ogView: TDi al ogVi ew 
defaultButton: TButton; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
PushFocus; 
SELF. Focus; 
IF InClass(SELF. control Panel. view, TDialogView) THEN 


BEGIN 
di alogView := TDial ogView(SELF. control Panel. view); 
default Button := dial ogView. default Button; 
IF defaultButton <> NIL THEN 
di alogView. PushButton( default Button) 
{may want to put in a delay loop here to assure hilit button seen} 


ELSE {dialog box has no default button; just take it down} 
current Window. TakeDownDi al ogBox; 

END 

ELSE {not a dialogView up there--must be a layout view} 
current Window. TakeDownDi al ogBox; 

PopFocus; 

{$1 FC fTrace}EP; {$ENDC} 

END; 


{$$ DI gHot } 
FUNCTION TDi al ogWi ndow. CanDoCommand(cmdNumber: TCmdNumber; VAR checkit: BOOLEAN): BOOLEAN 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
CASE cmdNumber OF 
uEdit Dial og: 
CanDoCommand : = TRUE; 
OTHERWI SE 
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000236 CanDoCommand := current Window. CanDoCommand(cmdNumber, checklt) 
000237 END; 

000238 {$1 FC fTrace}EP; {$ENDC} 

000239 END; 

000240 

000241 

000242 {$8 DI gHot} 

000243 PROCEDURE TDi al ogWi ndow. Disappear 

000244 BEGIN 


000245 {$1 FC fTrace}BP(11); {$ENDC} 

000246 SUPERSELF. Disappear 

000247 IF SELF.control Panel <> NIL THEN 

000248 IF InClass(SELF. control Panel. view, TDialogView) THEN 
000249 TDi al ogVi ew( SELF. control Panel. view).isShowing := FALSE; 
000250 {$1 FC fTrace}EP; {$ENDC} 

000251 END; 

000252 

000253 


000254 {$8 DI gHot} 
000255 FUNCTION TDial ogWi ndow. NewCommand(cmdNumber: TCmdNumber): TCommand 
000256 BEGIN 


000257 {$1 FC fTrace}BP(12); {$ENDC} 

000258 CASE cmdNumber OF 

000259 uEdit Dialog: 

000260 BEGIN 

000261 1F SELF.control Panel = NIL THEN 

000262 {$l1FC fDbgOK} 

000263 ABCBreak(' Dial ogWindow. NewCommand NIL ctl pnl', 0) 
000264 {$ENDC} 

000265 ELSE 

000266 IF NOT InClass(SELF. control Panel. view, TDialogView) THEN 
000267 {$lFC fDbgOK} 

000268 ABCBreak(' Dial ogWindow. NewCommand, not a dialog view, 0) 
000269 {$ENDC} 

000270 ELSE 

000271 TDi al ogDesi gnWi ndow. CREATE(NIL, SELF. Heap, TDi al ogView( SELF. control Panel. view)). Sei zeControl 
000272 NewCommand := NIL; 

000273 END; 

000274 OTHERW SE 

000275 NewCommand : = current Wndow. NewCommand(cmdNumber); 
000276 END; 

000277 {$1 FC fTrace}EP; {$ENDC} 

000278 END; 

000279 

000280 


000281 {$8 Digi nit} 
000282 BEGIN 
000283 SetRect(stdPlainBorders, - stdLeftRightMargin, -stdSlimTitleHeight - stdBottomBorder, stdLeftRight Margin, 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
000295 
000296 
000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 


END; 
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stdBottomBorder); 


SetRect(stdlDBorders , - stdlLeftRightMargin, -stdTitleHeight - stdBottomBorder, stdLleftRight Margin, 


stdBottomBorder); 
SetRect(stdThinBorders , 0, -stdSlimfitleHeight, 0, 0) 
SetPt(stdLabel Offset, 8, -2); 
Set Pt(stdFrmeOffset, 20, 0); 
SetRect(stdFrameBorders, -30, -16, 30, 16); 
SetRect(stdHdngBorders, -6, -12, 6, 4); 


nN 


MakeTypeStyle(famModern, sizel2Pitch, [], stdlnputTypeStyle); 
MakeTypeStyle(famModern, sizel5Pitch, [], titleTypeStyle) 
MakeTypeStyle(famModern, sizel2Pitch, [], stdHdngTypeStyle); 


copyright := 'Copyright 1983, 1984 by Apple Computer, Inc.'; 


METHODS OF TDi al ogView 


{$S 


DI gAl | oc} 


FUNCTION TDi alogView. CREATE{(object: TObject; heap: THeap; itsExtentLRect: LRect; itsPane 


BEGI 


itsPrintManager: TPrintManager; itsRes: Point) }; 


VAR root Dialog: TDi al og; 
di al ogWi ndow: TDi al ogWi ndow 
styl eSheet: TStyl eSheet; 
N 


{$1 FC fTrace}BP(11); {$ENDC} 


IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 


: TPanel 


SELF := TDialogView(TView. CREATE(object, heap, itsPanel, itsExtentLRect, itsPrintManager, stdMargins, 


(itsPrintManager <> NIL), itsRes, TRUE)) 
SELF. nonDialogExtent := itsExtentLRect; 


root Dialog := TDialog. CREATE(NIL, heap, 'ROOT', SELF); 
SELF.rootDialog := rootDialog; {create an empty master} 


styleSheet := TStyleSheet. CREATE(NIL, heap); 
SELF.styleSheet := styl eSheet; 


WTH SELF DO 
BEGIN 
isShowing := FALSE; {not yet actually put up} 
current Dialogl mage := NIL; 
defaultButton := NIL: 
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000332 hitButton := NIL; 

000333 

000334 paintFreeBoxes := FALSE; {client can set this to TRUE after the CREATE call} 
000335 paintSense := FALSE; 

000336 startedPainting := FALSE; 

000337 

000338 mouselsDown := FALSE; 

000339 magnetCursor := noCursor 

000340 END; 

000341 

000342 IF InClass(itsPanel. window, TDialogWndow) THEN 
000343 BEGIN 

000344 dial ogWindow := TDial ogWi ndow(itsPanel. wi ndow) 
000345 1F dialogWindow. control Panel = NIL THEN 
000346 di alogWindow. control Panel := itsPanel 
000347 1F dial ogWindow. dialogView = NIL THEN 
000348 di alogWindow. dialogView := SELF; 

000349 END; 

000350 {$I FC fTrace}EP; {$ENDC} 

000351 END; 

000352 

000353 


000354 {$8 DI gCol d} 
000355 PROCEDURE TDi al ogView. Free 
000356 BEGIN 


000357 {$I FC fTrace}BP(11); {$ENDC} 
000358 Free( SELF. root Di al og) 
000359 Free( SELF. styl eSheet); 
000360 SUPERSELF. Free 

000361 {$1 FC fTrace}EP; {$ENDC} 
000362 END; 

000363 

000364 


000365 {$l1FC fDebugMet hods} 

000366 {$8 DI gDbg} 

000367 PROCEDURE TDi al ogView. Fields( PROCEDURE Field(nameAndType: $255)) 
000368 BEGIN 


000369 SUPERSELF. Fiel ds( Field) 

000370 Field('rootDialog: TDialog'); 
000371 Field('nonDialogExtent: LRect') 
000372 Field('currentDialogl mage: TDialogl mage'); 
000373 Field('defaultButton: TButton') 
000374 Field('hitButton: TButton'); 
000375 Field('isShowing: BOOLEAN' ); 
000376 Field('paintFreeBoxes: BOOLEAN'); 
000377 Field('paintSense: BOOLEAN' ); 
000378 Field('startedPainting: BOOLEAN’ ) 
000379 Field('styleSheet: TStyleSheet' ); 


Apple Lisa ToolKit 3.0 Source Code Listing -- 375 of 1012 


Apple Lisa Computer Technical Information 


000380 Field('mouselsDown: BOOLEAN' ) 
000381 Field('magnetCursor: INTEGER' ); 
000382 Field(''); 

000383 END; 

000384 {$ENDC} 

000385 

000386 


000387 {$S DI gHot} 
000388 PROCEDURE TDi al ogVi ew. AbandonThat Button; 


000389 PROCEDURE TurnOut TheLi ghts; 

000390 BEGIN 

000391 SELF. hitButton. Hi ghli ght ( hOnToOff ) 
000392 END; 

000393 BEGIN 

000394 {$1 FC fTrace}BP(11); {$ENDC} 

000395 IF SELF. hitButton <> NIL THEN 

000396 BEGIN 

000397 SELF. panel. OnAl | PadsDo( TurnOut TheLi ghts) 
000398 [F SELF.currentDialogl mage = SELF. hitButton THEN 
000399 SELF. current Di alogl mage := NIL; 
000400 SELF. hitButton := NIL; 

000401 END; 

000402 {$1 FC fTrace}EP; {$ENDC} 

000403 END; 

000404 

000405 


000406 {$S DI gAlloc} 
000407 PROCEDURE TDi al ogView. AddDi al og(dialog: TDialog); 


000408 VAR dial ogWi ndow: TDi al ogWi ndow 

000409 BEGIN 

000410 {$1 FC fTrace}BP(11); {$ENDC} 

000411 SELF. root Dialog. Addl mage( di al og) 

000412 IF InClass(SELF. panel. window, TDialogWindow) THEN 
000413 BEGIN 

000414 di al ogWindow := TDi al ogWi ndow/ SELF. panel. wi ndow) 
000415 1F dial ogWindow. mai nDialog = NIL THEN 

000416 di alogWindow. mainDialog := dialog 

000417 END; 

000418 {$1 FC fTrace}EP; {$ENDC} 

000419 END; 

000420 

000421 


000422 {$S DI gAll oc} 
000423 FUNCTION TDi al ogView. AddNewDi alog(itsKey: $4): TDialog 


000424 VAR dial ogWi ndow: TDi al ogWi ndow 
000425 dialog: TDi al og; 
000426 BEGIN 

000427 {$1 FC fTrace}BP(11); {$ENDC} 
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000450 
000451 
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000453 
000454 
000455 
000456 
000457 
000458 
000459 
000460 
000461 
000462 
000463 
000464 
000465 
000466 
000467 
000468 
000469 
000470 
000471 
000472 
000473 
000474 
000475 
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dialog := TDialog.CREATE(NIL, SELF.Heap, itsKey, SELF) 
SELF. AddDi al og( dialog); 
AddNewDi alog := dialog 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl loc} 


PROCEDURE TDialogView. ActivateDialog(dialog: TDialog; whichWay: 


BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SELF. root Dialog. Activatel mage(dialog, whichWay); 
{$1FC fTrace}EP; {$ENDC} 

END; 


{$$ DI gHot} 

PROCEDURE TDial ogView. ButtonPushed( button: TButton); 
CONST delayTime = 50000 

VAR dialogView: TDial ogView 


command: TCommand 

sink: LONGI NT; 

i: LONGI NT; 
BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 
IF current Window. dialogBox <> NIL THEN 
BEGIN 


BOOLEAN) ; 


di alogView := TDi al ogVi ew( TDi al ogWi ndow( current Window. dial ogBox). control Panel. vi ew) 


command := NIL; 
1F dialogView = SELF THEN 


BEGIN 
sink := 124395; 
FOR i := 1 TO delayTime DO 


sink := sink - sink; 


dialogView. AbandonThatButton; {turn off highlighting just in case the dialog will be reused} 


IF button. cmdNumber <> noCmdNumber THEN 


command := currentWindow. selectPanel.sel ection. NewCommand( button. cmdNumber) 


current Window. TakeDownDi al ogBox; 
1F command <> NIL THEN 

current Window. PerformCommand( command) 
END; 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 


PROCEDURE TDial ogView. CheckboxHit(checkbox: TCheckbox; toggleDirection: BOOLEAN) 
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{The client will occasionally want to override this, in order to change the display as an 
immediate consequence of a Checkbox being toggl ed} 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 


{orien oJ 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
FUNCTION TDi al ogView. CursorAt(mouseLPt: LPoint): TCursorNumber 
VAR cursorNumber: TCursor Number 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
cursorNumber := noCursor; 
1F SELF. mouselsDown AND (SELF.magnetCursor <> noCursor) THEN 
cursorNumber := SELF. magnet Cursor 
ELSE 
BEGIN 
IF LRectHasLPt(SELF.rootDialog.extentLRect, mouseLPt) THEN 
cursorNumber := SELF. rootDialog. CursorAt(mouseLPt) 
IF cursorNumber = noCursor THEN 
cursorNumber := SELF. XCursorAt( mouseLPt):; 
END; 


CursorAt := cursorNumber 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
PROCEDURE TDi al ogVi ew. Draw 
VAR s: TListScanner: 
di alogl mage: TDi al ogl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SELF.isShowing := TRUE; {update event triggered this} 
SELF.rootDialog. Draw; {draw dialogs} 
SELF. XDraw; {draw other stuff} 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
PROCEDURE TDial ogView. EachActual Part( PROCEDURE DoToObject(filteredObj: TObject)); 
BEGIN 

{$I FC fTrace}BP(11); {$ENDC} 

SELF. root Di al ogl mage. EachActual Part (doToObj ect); 
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000524 {$1 FC fTrace}EP; {$ENDC} 

000525 END; 

000526 

000527 

000528 {$S DI gHot} 

000529 PROCEDURE TDi al ogView. MouseMove(mouseLPt: LPoint); 


000530 VAR current Dialogl mage: TDialogl mage 

000531 BEGIN 

000532 {$1 FC fTrace}BP(11); {$ENDC} 

000533 currentDialogl mage := SELF. current Dial ogl mage 

000534 IF currentDialogl mage <> NIL THEN 

000535 1F NOT currentDialogl mage. Still MyMouse( mouseLPt) THEN 
000536 current Di alogl mage := NIL; 

000537 

000538 IF currentDialogl mage = NIL THEN 

000539 BEGIN 

000540 current Dialogl mage := SELF. root Di al og. DownAt( mouseLPt) 
000541 IF currentDialogl mage = NIL THEN 

000542 SELF. XMouseMove( mouseLPt ) 

000543 END; 

000544 

000545 SELF. currentDialogl mage := current Dial ogl mage 

000546 {$1FC fTrace}EP; {$ENDC} 

000547 END; 

000548 

000549 


000550 {$8 DI gHot} 
000551 PROCEDURE TDi al ogView. MousePress(mouseLPt: LPoint); 


000552 VAR panel: TPanel; 

000553 takenBySel ection: BOOLEAN 

000554 current Dialogl mage: TDialogl mage 

000555 BEGIN 

000556 {$1 FC fTrace}BP(11); {$ENDC} 

000557 panel := SELF. panel 

000558 SELF.startedPainting := FALSE; 

000559 takenBySelection := FALSE; 

000560 

000561 SELF. mouselsDown := TRUE; 

000562 SELF. magnet Cursor := noCursor 

000563 

000564 currentDialogl mage := SELF. current Dial ogl mage 
000565 

000566 IF (current Dialogl mage <> NIL) AND (SELF. panel.selection. kind <> nothingKind) THEN 
000567 1F current Di alogl mage. Hit(mouseLPt) THEN 
000568 BEGIN 

000569 SELF. panel. selection. MousePress( mouseLPt); 
000570 takenBySelection := TRUE; 

000571 END; 
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|F NOT takenBySelection THEN 
BEGIN 
panel. Begi nSel ecti on; 
current Dialogl mage := SELF. root Di al og. DownAt( mouseLPt); 
1F currentDialogl mage = NIL THEN 
SELF. XMousePress( mouseLPt) 
END; 


SELF. currentDialogl mage := current Dial ogl mage 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
PROCEDURE TDi al ogVi ew. MouseRel ease 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SELF. mouselsDown := FALSE; 
SELF. magnet Cursor := noCursor 
[F SELF.currentDialogl mage <> NIL THEN 
SELF. current Dial og! mage. MouseRel ease 
ELSE 
SELF. XMouseRel ease 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 


PROCEDURE TDial ogView. PushButton( button: TButton); {client or ToolKit may call} 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
IF InClass(button. parent, TDialog) THEN 
TDi al og( button. parent). PushButton( button); 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAll oc} 
PROCEDURE TDi al ogView. Recal cExtent 
VAR newExtent: LRect; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
1F NOT EmptyLRect(SELF.rootDialog.extentLRect) THEN 
BEGIN 
[F NOT EmptyLRect(SELF. nonDialogExtent) THEN 
Uni onLRect(SELF.rootDialog.extentLRect, SELF.nonDialogExtent, newExtent); 
SELF. Resize(newExtent); 
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END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAll oc} 
PROCEDURE TDi al ogView. RemoveDialog(dialog: TDialog; andFree: BOOLEAN); 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SELF. root Dialog. Deletel mage(dialog, andFree); 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAll oc} 
PROCEDURE TDi al ogView. Repl aceDi al og(oldDialog, newDialog: TDialog); 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
SELF. root Dialog. Repl acel mage(oldDialog, newDi al og); 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl loc} 
PROCEDURE TDial ogView. SetDefaultButton( button: TButton); 
VAR thickPnSi ze: point 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SELF. defaultButton := button; 
Set Pt(thickPnSize, 3, 2); 
IF button <> NIL THEN 
button, buttonMetrics. penState. pnSize := thickPnSize 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
FUNCTION TDi al ogView. XCursorAt( mouseLPt: LPoint): TCursorNumber; 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
XCursorAt := arrowCursor:; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
PROCEDURE TDi al ogVi ew. XDraw 
BEGIN 
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000668 {$1 FC fTrace}BP(11); {$ENDC} 
000669 {$1 FC fTrace}EP; {$ENDC} 
000670 END; 

000671 

000672 


000673 {$S DI gHot} 

000674 PROCEDURE TDi al ogView. XMousePress(mouseLPt: LPoint); 
000675 BEGIN 

000676 {$1 FC fTrace}BP(11); {$ENDC} 

000677 {$1FC fTrace}EP; {$ENDC} 

000678 END; 

000679 

000680 

000681 {$S DI gHot} 

000682 PROCEDURE TDi al ogVi ew. XMouseMove( mouseLPt: LPoint); 
000683 BEGIN 

000684 {$1 FC fTrace}BP(11); {$ENDC} 

000685 {$1FC fTrace}EP; {$ENDC} 

000686 END; 

000687 

000688 

000689 {$S DI gHot} 

000690 PROCEDURE TDi al ogVi ew. XMouseRel ease 

000691 BEGIN 

000692 {$1 FC fTrace}BP(11); {$ENDC} 

000693 {$1FC fTrace}EP; {$ENDC} 

000694 END; 

000695 

000696 

000697 {$8 Diglnit} 

000698 END; 

000699 

QO0700 — Aes ietct ees teen ere en eae tee atc ee ene Set cee eae ee eee ate 
000701 

000702 

000703 METHODS OF TDi alogl mage 

000704 

000705 

000706 {$S TK2Start} 

000707 FUNCTION TDialogl mage. CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsld: $255; 


000708 itsView: TView; withChildren: BOOLEAN): TDialogl mage 
000709 VAR newList: TList; 

000710 BEGIN 

000711 {$1 FC fTrace}BP(11); {$ENDC} 

000712 IF object = NIL THEN 

000713 object := NewObject(heap, THISCLASS) 

000714 SELF := TDialogl mage(Tl mage. CREATE(object, heap, itsExtent, itsView)) 
000715 
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WTH SELF DO 
BEGIN 
parent := NIL 
isActive := TRUE; 
isEditable := TRUE; 
with D := FALSE: 
END; 

{$1 FC fTrace}EP; {$ENDC} 


END; 


{$1 FC fDebugMet hods} 

{$5 Dl gDbg} 

PROCEDURE TDi al ogl mage. Fields( PROCEDURE Field(nameAndType: $255)); 

BEGIN 
SUPERSELF. Fields(Field); 
Field('parent: TDialogl mage'); 
Field('isActive: BOOLEAN' ) 
Field('isEditable: BOOLEAN’ ) 
Field('withlD: BOOLEAN’); 
Field(''); 

END; 

{$ENDC} 


{$$ DI gCol d} 
PROCEDURE TDi al og! mage. Addl mage(dialogl mage: TDialogl mage); 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
{$I FC fTrace}EP; {$ENDC} 


{$S DI gAl loc} 
PROCEDURE TDi al ogl mage. Activatel mage(dialogl mage: TDialogl mage; whichWay: BOOLEAN) 
BEGIN 

{$I FC fTrace}BP(11); {$ENDC} 


IF dialoglmage.isActive <> whichWay THEN {state needs to change} 
BEGIN 
dialogl mage.isActive := whichWay; 
SELF. view. panel. I nvalLRect(dialoglmage.extentLRect); {??? Want to recalc my extent here???} 
END; 
{$1 FC fTrace}EP; {$ENDC} 
END; 
{$$ DI gCol d} 
PROCEDURE TDi al og! mage. BringToFront(dialogl mage: TDial ogl mage); 
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C fTrace}BP(11); {$ENDC} 
C fTrace}EP; {$ENDC} 


a4 
SS 
an 


{$$ DI gCol d} 
PROCEDURE TDi al ogl mage. ComeFor ward 
BEGIN 

{$1 FC fTrace}BP(11); {$ENDC} 

IF SELF.parent <> NIL THEN 

SELF. parent. BringToFront( SELF); 

{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
PROCEDURE TDi al ogl mage. Control Hit(control: TDialogl mage; toggleDirection: BOOLEAN); 
BEGIN 

{$1 FC fTrace}BP(11); {$ENDC} 


IF SELF. parent <> NIL THEN 
SELF. parent. Control Hit(control, toggleDirection); 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$$ DI gAl loc} 
PROCEDURE TDi al og! mage. Del etel mage(dialogl mage: TDialogl mage; andFree: BOOLEAN); 


BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
FUNCTION TDial ogl mage. DownAt(mouseLPt: LPoint): TDialogl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
IF SELF. Hit(mouseLPt) THEN 
BEGIN 
SELF. MousePress(mouseLPt); 
DownAt := SELF: 
END 
ELSE 
DownAt := NIL; 
{$1 FC fTrace}EP; {$ENDC} 
END; 
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000812 

000813 {$S Di gHot} 

000814 PROCEDURE TDi al og! mage. Draw 
000815 BEGIN 


000816 {$1 FC fTrace}BP(11); {$ENDC} 
000817 SELF. Draw] ust Me 

000818 {$1 FC fTrace}EP; {$ENDC} 
000819 END; 

000820 

000821 


000822 {$5 Di gDbg} {by desi gn} 
000823 PROCEDURE TDi al og! mage. Draw) ust Me 
000824 BEGIN 


000825 {$1 FC fTrace}BP( 113); {$ENDC} 
000826 {$1 FC fTrace}EP; {$ENDC} 
000827 END; 

000828 

000829 


000830 {$8 DI gHot} 
000831 PROCEDURE TDi al ogl mage. EachActual Part (PROCEDURE DoToObject(filteredObj: TObj ect)); 
000832 BEGIN 


000833 {$1 FC fTrace}BP(11); {$ENDC} 

000834 {overrides Tlmage's version, does specifically Nothing; Tl mageWthID redefines} 
000835 {$1 FC fTrace}EP; {$ENDC} 

000836 END; 

000837 

000838 


000839 {$8 DI gHot} 
000840 FUNCTION TDialogl mage. Hasild(id: $255): BOOLEAN; 
000841 BEGIN 


000842 {$I FC fTrace}BP(11); {$ENDC} 
000843 Has|D := FALSE: 

000844 {$1 FC fTrace}EP; {$ENDC} 
000845 END; 

000846 

000847 


000848 {$S SgLayout} 
000849 FUNCTION TDialogl mage.LaunchLayoutBox(view: TView): Tl mage 


000850 VAR myLayoutBox: TLayout Box; 

000851 pl anner Vi ew: TPl anner View 

000852 BEGIN 

000853 {$1 FC fTrace}BP(10); {$ENDC} 

000854 IF NOT SELF.isActive THEN 

000855 LaunchLayoutBox := NIL 

000856 ELSE 

000857 LaunchLayoutBox := TLayoutBox.CREATE(NIL, view. Heap, SELF.extentLRect, '', NIL, 
000858 view, SELF, stdPlainBorders, FALSE, FALSE, FALSE) 

000859 {$1 FC fTrace}EP; {$ENDC} 
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END; 


{$$ DI gHot} 
FUNCTION TDialogl mage. Object WthIDNumber(idNumber: INTEGER): TDi al ogl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Obj ect Wth!l DNumber := NIL; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
FUNCTION TDialogl mage. Obj Wthid(id: $255): TDialogl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Obj Wthid := NIL; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
PROCEDURE TDi al og! mage. PrepareToAppear 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
PROCEDURE TDi al og! mage. RecalcExtent; 
BEGIN 

{$1 FC fTrace}BP(11); {$ENDC} 

IF SELF. parent <> NIL THEN 

SELF. parent. Recal cExtent; 

{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gCol d} 
PROCEDURE TDi al ogl mage. Repl acel mage(replacee, newValue: TDi al ogl mage); 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
{$I FC fTrace}EP; {$ENDC} 


{$$ DI gHot } 
FUNCTION TDialogl mage. Still MyMouse( mouseLPt: LPoint): BOOLEAN 
BEGIN 
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{$1 FC fTrace}BP(11); {$ENDC} 
IF SELF. Hit(mouseLPt) THEN 
Still MyMouse := TRUE {I've handled it} 
ELSE 
Still MyMouse := FALSE; {give it to someone else} 
{default; this will usually be overridden in subclass} 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ Dil gl nit} 
E ' 


METHODS OF TI mageWi thi D; 


{$$ DI gHot} 
FUNCTION Ti mageWithID. CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsld: $255; 
itsView: TView; withChildren: BOOLEAN): Tl mageWthl D; 


VAR newList: TList; 
newl D: Tid; 
cState: TConvResult; 
newl DNumber: INTEGER 
BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := Tl mageWithI D( TDi alogl mage. CREATE(object, heap, itsExtent, itsID, itsView, withChildren)); 


newlD := Copy(itsid, 1, MIN(idLength, LENGTH(itsId))); 
StrUpperCased( @newl D) 
StrTolnt(@newlD, newl DNumber, cState); 
IF cState <> cvValid THEN 
newl DNumber := nol DNumber 


WTH SELF DO 
BEGIN 
id := newlD; 
idNumber := newl DNumber 
withld := TRUE; 
END; 

IF withChildren THEN 
BEGIN 
newList := TList.CREATE(NIL, heap, 0); 
SELF. children := newList 
END 

ELSE 
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SELF. children := NIL; 
{$1 FC fTrace}EP; {$ENDC} 
END; 
{$$ DI gWar m} 


FUNCTION TlmageWthID.Clone(heap: THeap): TObj ect; 
VAR children: TList; 
copy Of Myself: Tl mageWi thi D 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
copyOf Myself := Tl mageWthl D( SUPERSELF. Cl one( heap) ) 
IF SELF.children <> NIL THEN 
BEGIN 
children := TList(SELF. children. Cl one( heap) ); 
copyOfMyself.children := children; 
END; 


Clone := copyOf Myself; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gWar m} 
PROCEDURE TI mageWithl D. Free 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Free(SELF. children); 
SUPERSELF. Free: 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 


{$5 DI gDbg} 
PROCEDURE TI mageWithl D. Fields( PROCEDURE Field(nameAndType: 
BEGIN 
SUPERSELF. Fields( Field); 
Field('children: TList'); 
Field('id: STRING[9]'); 
Field('idNumber: | NTEGER' ) 
Field(''); 
END; 
{$ENDC} 
{$$ DI gHot } 
PROCEDURE Til mageWithI D. Activatel mage(dialogl mage: TDialogl mage; whichWay: BOOLEAN) 
BEGIN 
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001004 
001005 
001006 
001007 
001008 
001009 
001010 
001011 
001012 
001013 
001014 
001015 
001016 
001017 
001018 
001019 
001020 
001021 
001022 
001023 
001024 
001025 
001026 
001027 
001028 
001029 
001030 
001031 
001032 
001033 
001034 
001035 
001036 
001037 
001038 
001039 
001040 
001041 
001042 
001043 
001044 
001045 
001046 
001047 
001048 
001049 
001050 
001051 
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{$1 FC fTrace}BP(11); {$ENDC} 

IF dialoglmage.isActive <> whichWay THEN {state needs to change} 
BEGIN 
dialogl mage.isActive := whichWay; 
SELF. view. panel. | nvalLRect(dial ogl mage. extentLRect); 


END; 
{$I FC fTrace}EP; {$ENDC} 


END; 


{$$ 
PRO 
BEG 


DI gHot } 
CEDURE Tl mageWithlI D. Addl mage(dialogl mage: TDi al ogl mage); 
IN 

{$1 FC fTrace}BP(11); {$ENDC} 

SELF. children. | nsLast(dialogl mage) ; 

dialogl mage. parent := SELF; 

di alogl mage. HaveVi ew( SELF. vi ew) 

IF EmptyLRect(SELF.extentLRect) THEN 

SELF. extentLRect := dialogl mage.extentLRect 
ELSE 


-} UnionLRect(SELF.extentLRect, dialogl mage.extentLRect, SELF.extentLRect); {$H+} 


IF SELF. parent <> NIL THEN 
SELF. parent. Recal cExtent; 
{$I FC fTrace}EP; {$ENDC} 


END; 


{$$ 
PRO 


BEG 


END 


DI gHot } 
CEDURE Tl mageWithl D. BringToFront(dialogl mage: TDi al ogl mage) 
VAR s: TListScanner; 
image: TDialogl mage 
IN 
{$1 FC fTrace}BP(11); {$ENDC} 
1F SELF.children <> NIL THEN 
BEGIN 
s := SELF. children. Scanner; 
WHILE s.Scan(image) DO 
IF image = dialogl mage THEN 
BEGIN 
s. Del ete( FALSE); 
s. Done; 
SELF. children. insLast(dialogl mage); 
END; 
END; 
IF SELF. parent <> NIL THEN 
SELF. parent. BringToFront( SELF); 
{$1 FC fTrace}EP; {$ENDC} 
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001052 

001053 

001054 {$8 DI gHot} 

001055 FUNCTION Tl mageWthiD. CursorAt(mouseLPt: LPoint): TCursorNumber 


001056 VAR s: TListScanner 
001057 dial ogl mage: TDi al ogl mage 
001058 cursorNumber: TCursorNumber 


001059 {default: just passes the request on to children until one sets it} 
001060 BEGIN 


001061 {$1 FC fTrace}BP(11); {$ENDC} 

001062 cursorNumber := noCursor; 

001063 IF LRectHasLPt(SELF.extentLRect, mouseLPt) THEN 
001064 IF SELF.children <> NIL THEN 

001065 BEGIN 

001066 s := SELF.children. Scanner 

001067 WHILE s.Scan(dialogl mage) DO 

001068 IF dialogl mage.isActive THEN 

001069 BEGIN 

001070 cursorNumber := dialogl mage. CursorAt(mouseLPt); 
001071 1F cursorNumber <> noCursor THEN 
001072 s. Done; 

001073 END: 

001074 END; 

001075 CursorAt := cursorNumber; 

001076 {$1 FC fTrace}EP; {$ENDC} 

001077 END; 

001078 

001079 


001080 {$S DI gCol d} 
001081 PROCEDURE TI mageWithl D. Deletel mage(dialogl mage: TDialogl mage; andFree: BOOLEAN) 
001082 {deletes the indicated dialogl mage from my children} 


001083 VAR s: TListScanner 

001084 aDi al ogl mage: TDi al ogl mage 

001085 BEGIN 

001086 {$1 FC fTrace}BP(11); {$ENDC} 

001087 s:= SELF. children. Scanner 

001088 WHILE s.Scan(aDialogl mage) DO 

001089 1F aDialogl mage = dialogl mage THEN 

001090 BEGIN 

001091 IF (TDialogView(SELF.view).isShowing) AND (dialogl mage.isActive) THEN 
001092 SELF. view. panel. I nval LRect (dial ogl mage. extentLRect); 
001093 s. Del ete( andFree) 

001094 s. Done; 

001095 END; 

001096 {$1 FC fTrace}EP; {$ENDC} 

001097 END; 

001098 

001099 
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001100 
001101 
001102 
001103 
001104 
001105 
001106 
001107 
001108 
001109 
001110 
001111 
001112 
001113 
001114 
001115 
001116 
001117 
001118 
001119 
001120 
001121 
001122 
001123 
001124 
001125 
001126 
001127 
001128 
001129 
001130 
001131 
001132 
001133 
001134 
001135 
001136 
001137 
001138 
001139 
001140 
001141 
001142 
001143 
001144 
001145 
001146 
001147 
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{$$ DI gHot} 
PROCEDURE Tl mageWithl D. Draw 
PROCEDURE YouDraw(obj: TObj ect); 
VAR dialogl mage: TDialogl mage 
BEGIN 
di alogl mage := TDialogl mage( obj); 
IF dialogl mage.isActive THEN 
di alogl mage. Draw 
END; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
IF LRectIlsVisible(SELF.extentLRect) THEN 
BEGIN 
SELF. EachActual Part (YouDraw) 
SELF. Draw] ust Me; 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
PROCEDURE Tl mageWthl D. EachActual Part( PROCEDURE DoToObj ect(filteredObj: TObject)); 
BEGIN 

{$1 FC fTrace}BP(11); {$ENDC} 

1F SELF.children <> NIL THEN 

SELF. children. Each( DoToObj ect); 

{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
PROCEDURE Tl mageWthl D. EachVirtual Part (PROCEDURE DoToObject(filteredObj: TObj ect)); 
BEGIN 

{$I FC fTrace}BP(11); {$ENDC} 

SELF. EachActual Part(DoToObj ect); {???} 

{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 

FUNCTION Tl mageWthID.Hasid(id: $255): BOOLEAN 

BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 

{$H-} id := Copy(id, 1, MIN(idLength, LENGTH(id))); {$H+} 
StrUpperCased(@id); 


IF SELF.id 
Hasld : 


id THEN 
TRUE 
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001148 ELSE 

001149 Hasld := FALSE: 

001150 {$1 FC fTrace}EP; {$ENDC} 

001151 END; 

001152 

001153 

001154 {$8 DI gHot} 

001155 PROCEDURE Tl mageWthlD. HaveView(view: TVi ew) 


001156 PROCEDURE YouHaveView( obj: TObj ect); 
001157 VAR dialogl mage: TDi alogl mage 
001158 BEGIN 

001159 di alogl mage := TDialogl mage( obj); 
001160 dial ogl mage. HaveVi ew( vi ew); 
001161 END; 

001162 BEGIN 

001163 {$1 FC fTrace}BP(11); {$ENDC} 

001164 SELF.view := view 

001165 SELF. EachActual Part ( YouHaveVi ew); 
001166 {$1 FC fTrace}EP; {$ENDC} 

001167 END; 

001168 

001169 


001170 {$8 SgLlayout} 
001171 FUNCTION Til mageWth!D.LaunchLayoutBox(view: TView): Tl mage 


001172 VAR dial ogl mage: TDi al ogl mage 

001173 newExtent: LRect; 

001174 boxTitle: $255; 

001175 theString: TLegend; 

001176 childsLayout Box: TLayout Box; 

001177 myLayout Box: TLayout Box; 

001178 pl anner Vi ew: TPl anner Vi ew 

001179 post ChildExtent: LRect; 

001180 wi thChildren: BOOLEAN 

001181 PROCEDURE YouMakeLayout Boxes(obj: TObject); 

001182 VAR dial ogl mage: TDi al ogl mage 

001183 interiml mage: Tl mage 

001184 BEGIN 

001185 dialogl mage := TDialogl mage( obj); 

001186 interiml mage := dialogl mage. LaunchLayout Box( view); 
001187 IF interiml mage <> NIL THEN 

001188 BEGIN 

001189 childsLayoutBox := TLayoutBox(interi ml mage) 
001190 my Layout Box. Addl mage( chil dsLayout Box) 
001191 UnionLRect(postChildExtent, childsLayoutBox.extentLRect, postChildExtent); 
001192 END; 

001193 END; 

001194 BEGIN 

001195 {$1 FC fTrace}BP(10); {$ENDC} 
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001196 
001197 
001198 
001199 
001200 
001201 
001202 
001203 
001204 
001205 
001206 
001207 
001208 
001209 
001210 
001211 
001212 
001213 
001214 
001215 
001216 
001217 
001218 
001219 
001220 
001221 
001222 
001223 
001224 
001225 
001226 
001227 
001228 
001229 
001230 
001231 
001232 
001233 
001234 
001235 
001236 
001237 
001238 
001239 
001240 
001241 
001242 
001243 
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1F NOT SELF.isActive THEN 


LaunchLayout Box := NIL 
ELSE 
BEGIN {=} 
plannerView := TPlanner Vi ew( view); 
1F SELF.ID <> '' THEN 
boxTitle := SELF.id 
ELSE 
1F SELF.idNumber = nol DNumber THEN 
boxTitle :=' 
ELSE 
IntToString(SELF.idNumber, @boxTitle) 
withChildren := (SELF.children <> NIL); 
1F withChildren THEN 


withChildren := SELF.children. Size > 0: 


myLayoutBox := TLayout Box. CREATE(NIL, 


std! DBorders, FALSE, 


SELF. Heap, 
wi thChil dren, 


SELF. extentLRect, 
withChildren); 


boxTitle, NIL, plannerView, SELF, 


{default for a dialogl mage is for the layout box to SUPPRESS drawing the mani pul ee} 


postChildExtent := SELF.extentLRect; 
SELF. EachActual Part (YouMakeLayout Boxes); 


{i.e., WITHOUT my borders} 
{tells my children to make their own layout 


boxes; may grow postChil dExtent} 


my Layout Box. Recal cExtent; 
LaunchLayout Box := myLayout Box; 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
FUNCTION Tl mageWithl D. Obj ect With! DNumber(idNumber: | NTEGER) 
VAR s: TListScanner: 
dial ogl mage: TDi al ogl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Obj ect Wth!l DNumber := NIL; 
IF SELF.children <> NIL THEN 
BEGIN 
s := SELF.children. Scanner: 
WHILE s.Scan(dialogl mage) DO 
1F dialogl mage. withID THEN 
IF TimageWith! D(dialogl mage).idNumber = 
BEGIN 
Obj ect With! DNumber 
s. Done; 


:= dialogl mage 
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001244 END; 

001245 END; 

001246 {$1 FC fTrace}EP; {$ENDC} 

001247 END; 

001248 

001249 

001250 {$$ DI gHot } 

001251 FUNCTION Tl mageWthlD. Obj WthIld(id: $255): TDialogl mage 


001252 VAR s: TListScanner 

001253 di alogl mage: TDi al ogl mage 

001254 BEGIN 

001255 {$1 FC fTrace}BP(11); {$ENDC} 

001256 id := Copy(id, 1, MIN(idLength, LENGTH(id))) 
001257 StrUpperCased(@id); 

001258 Obj Withid := NIL; 

001259 IF SELF.children <> NIL THEN 

001260 BEGIN 

001261 s := SELF.children. Scanner; 

001262 WHILE s.Scan(dialogl mage) DO 

001263 IF dialogl mage. withID THEN 
001264 IF Ti mageWith! D(dialogl mage).id = id THEN 
001265 BEGIN 

001266 Obj Wthid := dialogl mage 
001267 s. Done 

001268 END; 

001269 END; 

001270 {$1 FC fTrace}EP; {$ENDC} 

001271 END; 

001272 

001273 


001274 {$8 DI gHot} 
001275 PROCEDURE Tl mageWthliD. OffSetBy(deltaLPt: LPoint); 


001276 PROCEDURE YouOffset(obj: TObj ect); 

001277 BEGIN 

001278 TDi al ogl mage( obj). Offset By(deltaLPt) 

001279 END; 

001280 BEGIN 

001281 {$1 FC fTrace}BP(11); {$ENDC} 

001282 {$H-} OffsetLRect(SELF.extentLRect, deltaLPt.h, deltaLPt.v); {$H+} 
001283 SELF. EachActual Part(YouOffset); {tells children} 
001284 {$1 FC fTrace}EP; {$ENDC} 

001285 END; 

001286 

001287 


001288 {$8 DI gWarm} 

001289 PROCEDURE Tl mageWthID.RecalcExtent; {a bottom-up communication line; child who changes tells 
001290 his parent, who changes himself and then tells HIS parent} 
001291 VAR s: TListScanner 
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001292 dial ogl mage: TDi al ogl mage 

001293 newExtent: LRect; 

001294 BEGIN 

001295 {$1 FC fTrace}BP(11); {$ENDC} 

001296 {can be speeded up} 

001297 IF SELF.children <> NIL THEN 

001298 IF SELF.children. Size > 0 THEN 

001299 BEGIN 

001300 newExtent := zeroLRect 

001301 s := SELF.children. Scanner 

001302 WHILE s.Scan(dialogl mage) DO 
001303 [F EmptyLRect(newExtent) THEN 
001304 newExtent := dialogl mage. extentLRect 
001305 ELSE 

001306 Uni onLRect(newExtent, dialogl mage, extentLRect, newExtent) 
001307 SELF. Resi ze(newExtent); 

001308 END; 

001309 IF SELF. parent <> NIL THEN 

001310 SELF. parent. Recal cExtent; 

001311 {$1 FC fTrace}EP; {$ENDC} 

001312 END; 

001313 

001314 


001315 {$8 DI gCol d} 

001316 PROCEDURE TI mageWthlID. Repl acel mage(replacee, newValue: TDi al ogl mage); 
001317 {make this such that it puts back at same place; or use Become} 
001318 BEGIN 


001319 {$1 FC fTrace}BP(11); {$ENDC} 
001320 SELF. Deletel mage(replacee, TRUE) 
001321 SELF. Addl mage( newVal ue) 

001322 {$1 FC fTrace}EP; {$ENDC} 

001323 END; 

001324 

001325 


001326 {$8 DI gHot} 
001327 FUNCTION Tl mageWthiD. Still MyMouse(mouseLPt : LPoint): BOOLEAN; 
001328 BEGIN 


001329 {$1 FC fTrace}BP(11); {$ENDC} 

001330 IF SELF. Hit(mouseLPt) THEN 

001331 Still MyMouse := TRUE {I've handled it} 

001332 ELSE 

001333 Still MyMouse := FALSE; {give it to someone else} 
001334 {default; this will usually be overridden in subclass} 
001335 {$1 FC fTrace}EP; {$ENDC} 

001336 END; 

001337 

001338 


001339 {$S Digi nit} 
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001340 
001341 
001342 
001343 
001344 
001345 
001346 
001347 
001348 
001349 
001350 
001351 
001352 
001353 
001354 
001355 
001356 
001357 
001358 
001359 
001360 
001361 
001362 
001363 
001364 
001365 
001366 
001367 
001368 
001369 
001370 
001371 
001372 
001373 
001374 
001375 
001376 
001377 
001378 
001379 
001380 
001381 
001382 
001383 
001384 
001385 
001386 
001387 
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END; 


METHODS OF TDi alog; 


{$$ DI gAll oc} 


FUNCTION TDi alog. CREATE( object: TObject; heap: THeap; itsKey: $4; itsView: TView): TDialog 


VAR itsStringKey: 
itsExtent: 


TStringKey; 
LRect; 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
WTH stdButtonMetrics DO 
BEGIN 
height := stdBtnHei ght; 
curvH := stdCurvH 
curvV := stdCurvV 
typeStyle := sysTypeStyle; 


penState := normal Pen; 
expandNum := 4; 
expandDen := 3; 
absMinWdth := 80; 
END; 


IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 


SELF := TDialog(TIl mageWthID. CREATE(object, heap, zeroLRect, itsKey, itsView 
{get it into LONGINT form} 


XferLeft(Ptr( ORD( @itsKey) +1), @itsStringKey.trueKey, 4); 


itsStringKey. key := itsKey; 
SELF.stringKey := itsStringKey 
{$I FC fTrace}EP; {$ENDC} 


END; 


{$1 FC fDebugMet hods} 
{$5 Dl gDbg} 
PROCEDURE TDialog.Fields( PROCEDURE Field(nameAndType: $255)) 
BEGIN 
SUPERSELF. Fields( Field); 


Field('stringKey: RECORD trueKey: LONGINT; key: STRING[4] END'); 


Field(''); 
END; 
{$ENDC} 
{$$ DI gAll oc} 


FUNCTION TDialog. NewButton(itsPhrase: INTEGER; itsMetrics: TButtonMetrics; sameSizedButton 


itsCmdNumber: TCmdNumber): TButton 
VAR itsID: $255; 
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itsLocation: LPoint; 
button: TButt on; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Get TextAndLocation(itsPhrase, itsID, itsLocati on) 
button := SELF. AddButton(its!ID, itsLocation, itsMetrics, sameSizedButton, itsCmdNumber); 
button.idNumber := itsPhrase 
NewButton := button: 
{$1 FC fTrace}EP; {$ENDC} 


END: 
{$$ DI gAll oc} 
FUNCTION TDialog. NewCluster(itsPhrase: INTEGER): TCluster 
VAR itsID: $255: 
itsLocation: LPoint; 
cluster: TCluster; 
BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 
Get TextAndLocation(itsPhrase, itsID, itsLocati on) 
cluster := SELF. AddStdCluster(itsID, itsLocation.h, itsLocation.v); 
cluster.idNumber := itsPhrase 
NewCluster := cluster; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl 1 oc} 
FUNCTION TDialog. NewFreeCheckbox(itsPhrase: INTEGER; boxWidth: INTEGER 
boxHei ght: INTEGER; wantLabel: BOOLEAN; label Offset: Point; itsTypeStyle: TTypeStyle): TCheckBox; 
VAR itsID: $255; 
itsLocation: LPoint; 
checkbox: TCheckbox; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Get TextAndLocation(itsPhrase, itsID, itsLocati on) 
checkbox := SELF. AddFreeCheckbox(itsID, itsLocation.h, itsLocation.v, boxWidth, boxHei ght 
wantLabel, labelOffset, itsTypeStyle); 
checkbox.idNumber := itsPhrase 
NewFreeCheckbox := checkbox: 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$S DI gAl loc} 

FUNCTION TDialog. NewlnputFrame(itsPhrase: INTEGER; promptTypeStyle: TTypeStyle 
inputOffset: Point; inputTypeStyle: TTypeStyle; 
maxl nputChars: INTEGER; itsBorders: Rect; drawlnputLRect: BOOLEAN 


Apple Lisa ToolKit 3.0 Source Code Listing -- 397 of 1012 


001436 
001437 
001438 
001439 
001440 
001441 
001442 
001443 
001444 
001445 
001446 
001447 
001448 
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001453 
001454 
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001456 
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001461 
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001463 
001464 
001465 
001466 
001467 
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001470 
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001474 
001475 
001476 
001477 
001478 
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001480 
001481 
001482 
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drawHitLRect: BOOLEAN): TlnputFrame 


VAR itsID: $255; 
itsLocation: LPoint; 
input Frame: Tl nput Frame; 


inputLocation: LPoint; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Get TextAndLocation(itsPhrase, itsID, itsLocation) 


Set QDTypeStyl e( prompt TypeSt yl e) 
WTH inputLocation DO 


BEGIN 

h := itsLocation.h + StringWdth(itsID) + inputOffset.h; 
v := itsLocation.v + inputOffset.v; 

END; 


inputFrame := SELF. Addi nputFrame(its!D, itsLocation, promptTypeStyle 
inputLocation, inputTypeStyle, maxInputChars, itsBorders, drawlnputLRect, 
drawHitLRect); 
inputFrame.idNumber := itsPhrase 
Newl nputFrame := inputFrame 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl loc} 
FUNCTION TDialog. NewLegend(itsPhrase: INTEGER; itsTypeStyle: TTypeStyle): TLegend 
VAR itsID: $255; 
itsLocation: LPoint; 
legend: TLegend; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Get TextAndLocation(itsPhrase, itsID, itsLocation) 
legend := SELF. AddStdLegend(itsID, itsLocation.h, itsLocation.v, itsTypeStyle); 


NewLegend := legend 
{$I FC fTrace}EP; {$ENDC} 
END; 
{$$ DI gAl loc} 


FUNCTION TDialog. NewRowOf Boxes(itsPhrase: INTEGER; numberOf Boxes: INTEGER 


starting! DNumber: | NTEGER; boxWidth: INTEGER; boxHeight: INTEGER; boxSpacing: INTEGER): 


VAR itsID: $255; 
itsLocation: LPoint; 
cluster: TCluster; 

BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 
Get TextAndLocation(itsPhrase, itsID, itsLocati on) 
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001484 cluster := SELF. AddRowOfBoxes(itsID, itsLocation.h, itsLocation.v, number Of Boxes 
001485 startingl DNumber, boxWidth, boxHeight, boxSpacing); 

001486 cluster.idNumber := itsPhrase 

001487 NewRowOf Boxes := cluster; 

001488 {$1 FC fTrace}EP; {$ENDC} 

001489 END; 

001490 

001491 


001492 {$S DI gAl loc} 
001493 PROCEDURE TDi alog. AddOKButton(cmdNumber: TCmdNumber); 


001494 VAR button: TButton; 

001495 BEGIN 

001496 {$1 FC fTrace}BP(11); {$ENDC} 

001497 button := SELF. NewButton(phOK, stdButtonMetrics 

001498 TButton( SELF. Obj ect Wthl DNumber(phCancel)), cmdNumber) 
001499 {$1 FC fTrace}EP; {$ENDC} 

001500 END; 

001501 

001502 


001503 {$8 DI gAll oc} 
001504 PROCEDURE TDi al og. AddCancel Button(cmdNumber: TCmdNumber) 


001505 VAR button: TButton; 

001506 BEGIN 

001507 {$1 FC fTrace}BP(11); {$ENDC} 

001508 button := SELF. NewButton(phCancel, stdButtonMetrics, 

001509 TButton( SELF. Obj ect Wthl DNumber( phOK)), cmdNumber); 
001510 {$1 FC fTrace}EP; {$ENDC} 

001511 END; 

001512 

001513 


001514 {$8 DI gAlloc} 
001515 FUNCTION TDialog. AddBigFreeCheckbox(itsld: $255; itsXLoc, itsYLoc: LONGINT): TCheckbox; {---} 
001516 VAR location: LPoint; 


001517 itsChars: $255; 

001518 newBox: TCheckbox; 

001519 label Offset: Point; 

001520 typeStyle: TTypeStyle 

001521 BEGIN 

001522 {$I1FC fTrace}BP(11); {$ENDC} 

001523 SetLPt(location, itsXLoc, itsYLoc) 

001524 SetPt(labelOffset, 20, -4); 

001525 MakeTypeStyle(famClassic, sizel8Point, [], typeStyle) 
001526 newBox := TCheckbox.CREATE(NIL, SELF.Heap, itsld, SELF.view, location, 36, 24, TRUE, 
001527 label Offset, typeStyle) 

001528 SELF. Addl mage( newBox) 

001529 AddBi gFreeCheckbox := newBox; 

001530 {$I1FC fTrace}EP; {$ENDC} 

001531 END; 
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{$$ DI gAl loc} 
FUNCTION TDialog. AddButton(itsld: $255; itsLocation: LPoint; itsMetrics: TButtonMetrics 
sameSizedButton: TButton; itsCmdNumber: TCmdNumber): TButton; 
VAR button: TButton; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
button := TButton. CREATE(NIL, SELF. Heap, itsid, SELF.view, itsLocation, itsMetrics 
sameSizedButton, itsCmdNumber); 
SELF. Addl mage( button); 
AddButton := button; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAll oc} 
FUNCTION TDialog. AddStdButton(itsid: $255; itsXLoc, itsYLoc: LONGINT; sameSizedButton: TButton; 
itsCmdNumber: TCmdNumber): TButton; 
VAR location: LPoint 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SetLPt(location, itsXLoc, itsYLoc); 
AddStdButton := SELF. AddButton(itsID, location, stdButtonMetrics, sameSizedButton, itsCmdNumber); 
{$1 FC fTrace}EP; {$ENDC} 


END; 

{$$ DI gAl loc} 

FUNCTION TDi alog. AddStdFreeCheckbox(itsid: $255; itsXLoc, itsYLoc: LONGINT): TCheckBox; 
VAR legend: TLegend 


location: LPoint; 
checkbox: TCheckbox; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SetLPt (location, itsXLoc, itsYLoc); 
checkbox := TCheckbox. CREATE(NIL, SELF.Heap, itsid, SELF.view, location, stdBoxWidth, 
stdBoxHei ght, TRUE, stdLabel Offset, sysTypeStyle); 
SELF. Addl mage( checkbox); 
AddStdFreeCheckbox := checkbox; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl loc} 
FUNCTION TDialog. AddStdCluster(itsld: $255; itsXLoc, itsYLoc: LONGINT): TCluster 
VAR location: LPoint; 
cluster: TCluster; 
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BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
SetLPt(location, itsXLoc, itsYLoc); 
cluster :=TCluster. CREATE(NIL, SELF.Heap, itsld, SELF.view, location) 
SELF. Addl mage(cluster); 
AddStdCluster := cluster 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl loc} 
FUNCTION TDialog. AddFreeCheckbox(itsID: $255; itsXLoc, itsYLoc: LONGINT; boxWidth: | NTEGER 
boxHei ght: INTEGER; wantLabel: BOOLEAN; label Offset: Point; itsTypeStyle: TTypeStyle): TCheckbox; 
VAR location: LPoint; 
checkbox: TCheckbox: 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
SetLPt(location, itsXLoc, itsYLoc); 
checkbox := TCheckbox. CREATE(NIL, SELF.Heap, itsID, SELF.view, location, boxWdth, boxHei ght, 
wantLabel, labelOffset, itsTypeStyle); 
SELF. Addl mage( checkbox) 
AddFreeCheckbox := checkbox; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl loc} 
FUNCTION TDialog. Addi nputFrame(itsld: $255; 
promptLocation: LPoint; promptTypeStyle: TTypeStyle; 
inputLocation: LPoint; inputTypeStyle: TTypeStyle 
maxl nputChars: INTEGER; itsBorders: Rect; drawlnputLRect: BOOLEAN 
drawHitLRect: BOOLEAN): Tl nput Frame 
VAR inputFrame: Ti nput Frame 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
inputFrame := TlnputFrame. CREATE(NIL, SELF.Heap, itsID, SELF.view, promptLocation, promptTypeStyle 
inputLocation, inputTypeStyle, maxI nputChars, itsBorders 
drawl nputLRect, drawHitLRect); 
SELF. Addl mage(inputFrame) ; 


Addi nputFrame := input Frame; 
{$I FC fTrace}EP; {$ENDC} 

END; 

{$$ DI gAll oc} 


FUNCTION TDi al og. AddRow0f Boxes(its!D: $255; itsXLoc, itsYLoc: LONGINT; numberOf Boxes: INTEGER; 
starting! DNumber: | NTEGER; boxWidth: INTEGER; boxHeight: INTEGER; boxSpacing: INTEGER): TCluster 
VAR current! DNumber: INTEGER 


Apple Lisa ToolKit 3.0 Source Code Listing -- 401 of 1012 


001628 
001629 
001630 
001631 
001632 
001633 
001634 
001635 
001636 
001637 
001638 
001639 
001640 
001641 
001642 
001643 
001644 
001645 
001646 
001647 
001648 
001649 
001650 
001651 
001652 
001653 
001654 
001655 
001656 
001657 
001658 
001659 
001660 
001661 
001662 
001663 
001664 
001665 
001666 
001667 
001668 
001669 
001670 
001671 
001672 
001673 
001674 
001675 


Apple Lisa Computer Technical Information 


checkbox: TCheckbox; 
newLocati on: LPoint; 
newl D: $255; 
cluster: TCluster; 


BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
cluster := SELF. AddStdCluster(itsID, itsXLoc, itsYLoc); 
FOR current! DNumber := startingl DNumber TO (startinglDNumber + numberOfBoxes - 1) DO 
BEGIN 
IF cluster.|astBox = NIL THEN {this is the first to be inserted} 
newLocation := cluster.location 
ELSE { There is already at least one box in the cluster -- align to right of it} 
WITH newlocation DO 
BEGIN 
h := cluster. lastBox.rectl mage.extentLRect. right + boxSpacing; {??} 
v := cluster. |astBox. rectl mage. extentLRect. top; 
END; 
IntToString(current!DNumber, @newl D) 
checkbox := cluster. AddCheckbox(newlD, newLocation, boxWidth, boxHeight, FALSE, zeroPt, 
sysTypeStyle, FALSE); 
checkBox.|DNumber := current! DNumber 
END; 
AddRow0f Boxes := cluster; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl loc} 
FUNCTION TDialog. AddStdilnputFrame(itsild: $255; itsXLoc: LONGI NT; 
itsYLoc: LONGINT; maxi nputChars : INTEGER): Tl nput Frame; 
VAR promptLocation: LPoint; 
inputLocation: LPoint; 
input Frame: Tl nput Frame; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SetLPt(promptLocation, itsXLoc, itsYLoc); 


Set QDTypeStyle(sysTypeStyle); 


WTH inputLocation DO 


BEGIN 

h := itsXLoc + StringWidth(its!ID) + 20 
v := itsYLoc; 

END; 


inputFrame := Tl nputFrame.CREATE( NIL, SELF.Heap, itsid, SELF. view, promptLocation, sysTypeStyle 


inputLocation, stdlnputTypeStyle, maxInputChars 
stdFrameBorders, TRUE {draw input LRect}, TRUE {draw HitLRect}) 
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001676 SELF. Addl mage(i nput Frame) 
001677 AddStdinputFrame := input Frame; 
001678 {$1 FC fTrace}EP; {$ENDC} 

001679 END; 

001680 

001681 


001682 {$8 DI gAll oc} 
001683 FUNCTION TDialog. AddStdLegend(itsld: $255; itsXLoc, itsYLoc: LONGI NT 


001684 itsTypeStyle: TTypeStyle): TLegend 
001685 VAR newString: TLegend 

001686 BEGIN 

001687 {$1 FC fTrace}BP(11); {$ENDC} 

001688 newString := NewStdLegend(SELF. Heap, itsID, itsXLoc, itsYLoc, SELF.view, itsTypeStyle) 
001689 SELF. Addl mage(newString); 

001690 AddStdLegend := newString 

001691 {$1 FC fTrace}EP; {$ENDC} 

001692 END; 

001693 

001694 


001695 {$S DI gAll oc} 
001696 FUNCTION TDialog. AddSysLegend(itsld: $255; itsXLoc, itsYLoc: LONGINT): TLegend 


001697 VAR newString: TLegend 

001698 BEGIN 

001699 {$1 FC fTrace}BP(11); {$ENDC} 

001700 newString := NewSysLegend(SELF. Heap, itsID, itsXLoc, itsYLoc, SELF. view) 
001701 SELF. Addl mage( newString); 

001702 AddSysLegend := newString 

001703 {$1 FC fTrace}EP; {$ENDC} 

001704 END; 

001705 

001706 


001707 {$S DI gHot } 
001708 PROCEDURE TDialog. ButtonPushed( button: TButton); {usually'l!] be called through SUPERSELF} 
001709 BEGIN 


001710 {$1 FC fTrace}BP(11); {$ENDC} 

001711 1F SELF. parent <> NIL THEN 

001712 TDi al og(SELF. parent). Butt onPushed( button) 
001713 ELSE 

001714 TDi al ogVi ew( SELF. view). Butt onPushed( button) 
001715 {$1 FC fTrace}EP; {$ENDC} 

001716 END; 

001717 

001718 


001719 {$S DI gHot} 
001720 PROCEDURE TDialog. CheckboxHit(checkbox: TCheckbox; toggleDirection: BOOLEAN) 


001721 {default--passes up the line; client can rei mpl ement } 
001722 BEGIN 
001723 {$1 FC fTrace}BP(11); {$ENDC} 
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IF SELF. parent <> NIL THEN 
BEGIN 
IF InClass(SELF. parent, TDialog) THEN 

TDi al og( SELF. parent). CheckboxHit(checkbox, toggleDirecti on) 

ELSE 

SELF. parent. Control Hit(checkbox, toggleDirection); 
END 

ELSE 
TDi al ogVi ew( SELF. view). CheckboxHit(checkbox, toggleDirection); 

{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
PROCEDURE TDialog. Control Hit(control: TDialogl mage; toggleDirection: BOOLEAN); 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
IF InClass(control, TButton) THEN 
SELF. ButtonPushed(TButton(control)) {this branch perhaps not achievable in current design} 
ELSE 
IF InClass(control, TCheckbox) THEN 
SELF. CheckboxHit(TCheckbox(control), toggleDirecti on); {Client can add own kinds by redefining this} 
{$I FC fTrace}EP; {$ENDC} 
D: 


END; 
{$$ DI gHot } 
FUNCTION TDi alog. DownAt( mouseLPt: LPoint): TDialogl mage 
VAR s: TList Scanner; 
di alogl mage: TDi al ogl mage 


current Dialogl mage: TDialogl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
currentDialogl mage := NIL; 
IF SELF. Hit(mouseLPt) THEN 
BEGIN 
s := SELF.children. Scanner; 
WHILE s.Scan(dialogl mage) DO 
IF dialoglmage.isActive THEN 
BEGIN 
current Di alogl mage := dialogl mage. DownAt( mouseLPt); 
IF current Dialogl mage <> NIL THEN 
s. Done; 
END; 
END; 
DownAt := currentDi al ogl mage 
{$1 FC fTrace}EP; {$ENDC} 
END; 
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{$$ DI gHot } 
PROCEDURE TDi al og. PushButton( button: TButton); {client or ToolKit may call} 
PROCEDURE TurnOnThe) uice 
BEGIN 
button. Hi ghl i ght ( hOffToOn); 
END; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
1F NOT button. isHighlighted THEN 
SELF. view. panel. OnAl | PadsDo( Tur nOnThe) ui ce) 
TDi al ogView(SELF. view). hitButton := button; 
SELF. ButtonPushed( button); 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gWar m} 
PROCEDURE TDi al og. Recal cExtent; 
BEGIN 
{$I FC fTrace}BP(11); {$ENDC} 
SUPERSELF.RecalcExtent; {build up my size as the sumof the sizes of my children} 
IF SELF.parent = NIL THEN 
SELF. view. Recal cExtent; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAll oc} 
PROCEDURE TDialog. Set DefaultButton( button: TButton); 
VAR thickPnSi ze: point 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
IF SELF.parent <> NIL THEN 
TDi al og(SELF. parent). Set Def aul t Butt on( button) 
ELSE 
TDi al ogVi ew( SELF. view). Set Default Button( button); 
{$1 FC fTrace}EP; {$ENDC} 


END; 
{$$ DI gHot } 
PROCEDURE TDialog. SelectI nputFrame(inputFrame: Tl nput Frame) 
VAR panel: TPanel; 
newFrameSel: TFrameSel ection; 
BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 
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001820 panel := SELF. view. panel; 

001821 panel. Begi nSel ection; 

001822 newFrameSel := TFrameSelection(panel.selection. FreedAndRepl acedBy( 
001823 TFrameSelection. CREATE(NIL, SELF.Heap, inputFrame))) 
001824 newFrameSel.coSelecti on, Become( 

001825 input Frame. text Dial ogl mage. textl mage. text. SelectAll ( 

001826 input Frame, text Di al ogl mage. text! mage) ); 

001827 panel. Highlight(panel.selection. coSelection, hOffToOn); 

001828 {$1 FC fTrace}EP; {$ENDC} 

001829 END; 

001830 

001831 


001832 {$8 Diglnit} 

001833 END; 

001834 

001835 

O01G26: . feecustlicateicetetecsieenioeeds tens seGitehe se eediaeh tecen tecetateesieetaede ame ted Hema tienes Hes 
001837 

001838 

001839 METHODS OF TButton; 

001840 

001841 

001842 {$8 DI gAll oc} 

001843 FUNCTION TButton. CREATE(obj ect: TObject; heap: THeap; itsld: $255; itsView: TView 


001844 itsLocation: LPoint; itsMetrics: TButtonMetrics 

001845 sameSizedButton: TButton; itsCmdNumber: TCmdNumber): TButton; 
001846 

001847 VAR buttonLRect: LRect; 

001848 itsLegend: TLegend; 

001849 BEGIN 

001850 {$1 FC fTrace}BP(11); {$ENDC} 

001851 SetLRect(buttonLRect, -1, 0, 1, 1) 

001852 OffsetLRect(buttonLRect, itsLocation.h, itsLocati on. v) 

001853 IF object = NIL THEN 

001854 object := NewObject(heap, THISCLASS) 

001855 SELF := TButton(TIl mageWithlD. CREATE(object, heap, buttonLRect, itsld, itsView, TRUE)) 
001856 

001857 WTH SELF DO 

001858 BEGIN 

001859 cmdNumber := itsCmdNumber 

001860 buttonMetrics := itsMetrics 

001861 isHighlighted := FALSE; 

001862 {minWidth will be set by RecalcExtent} 

001863 END; 

001864 

001865 IF sameSizedButton <> NIL THEN {weave me into chain of same-sized buttons} 
001866 BEGIN 

001867 SELF. next SameSi zedButton := sameSi zedButton. next SameSi zedButton; 
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sameSi zedButton. nextSameSizedButton := SELF: 
END 

ELSE 
SELF. nextSameSizedButton := SELF; 


itsLegend := NewStdLegend(heap, itsID, itsLocation.h, itsLocation.v, SELF. view 
itsMetrics.typeStyle); 

SELF. Addl mage(itsLegend); 

SELF. Resize(buttonLRect); {the Addl mage will've made things out of balance} 

SELF.legend := itsLegend; 

itsLegend. wouldBeDraggable := FALSE; {as an entity unto itself during layout} 


SELF. RecalcExtent; {performs lots of magic} 


{$I FC fTrace}EP; {$ENDC} 


{$1 FC fDebugMet hods} 


{$S 


DI gDbg} 


PROCEDURE TButton. Fields( PROCEDURE Field(nameAndType: $255)) 


BEGI 


END; 


N 

SUPERSELF. Fields( Field); 

Field('cmdNumber: I NTEGER' ) 

Field('minWidth: I NTEGER' ) 

Field('isHighlighted: BOOLEAN’ ) 

Field('nextSameSizedButton: TButton' ) 

Field('legend: TLegend'); 

Fiel d( CONCAT('buttonMetrics: RECORD height: INTEGER; curvH: INTEGER; curvV: INTEGER; ' 
‘typeStyle: LONGINT; expandNum: INTEGER; expandDen: | NTEGER;' 
‘absMinWidth: INTEGER; penState: ARRAY[1..18] OF Byte END')); 

Field(''); 


{$ENDC} 


{$$ 


DI gHot } 


PROCEDURE TButton. Draw) ust Me; 


BEGI 


END; 


N 
{$1 FC fTrace}BP(11); {$ENDC} 
Set PenState(SELF. buttonMetrics. penState); 
FrameLRRect(SELF.extentLRect, SELF. buttonMetrics.curvH, SELF. buttonMetrics.curvV); 
[F SELF.isHighlighted THEN 
InvetLRRect(SELF.extentLRect, SELF. buttonMetrics.curvH, SELF. buttonMetrics. curvV) 
{$1 FC fTrace}EP; {$ENDC} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 407 of 


1012 


Apple Lisa Computer Technical Information 


001916 {$S DI gHot } 
001917 PROCEDURE TButton. Hi ghlight(highTransit: THighTransit); 
001918 BEGIN 


001919 {$1 FC fTrace}BP(11); {$ENDC} 

001920 InvetLRRect(SELF.extentLRect, SELF. buttonMetrics.curvH, SELF. buttonMetrics.curvV); 
001921 SELF.isHighLighted := (highTransit = hOffToOn) 

001922 {$1 FC fTrace}EP; {$ENDC} 

001923 END; 

001924 

001925 


001926 {$8 Di gLayout} 
001927 FUNCTION TButton, LaunchLayoutBox(view: TView): Tl mage 


001928 VAR | ayout Box: TLayout Box; 
001929 layBoxExtent: LRect; 

001930 S! TListScanner; 
001931 childLayoutBox: TLayout Box 
001932 BEGIN 

001933 {$1 FC fTrace}BP(11); {$ENDC} 
001934 LaunchLayoutBox := TButtonLayoutBox.CREATE(NIL, SELF.Heap, SELF, view) 
001935 {$1 FC fTrace}EP; {$ENDC} 

001936 END; 

001937 

001938 


001939 {$8 DI gHot} 
001940 PROCEDURE TButton. MousePress( mouseLPt: LPoint); 


001941 PROCEDURE TurnOnButton; 
001942 BEGIN 

001943 SELF. Hi ghLi ght ( hOff ToOn) 
001944 END; 

001945 BEGIN 

001946 {$1 FC fTrace}BP(11); {$ENDC} 
001947 SELF. view. panel. OnAl | Pads Do( TurnOnButt on) 
001948 {$1 FC fTrace}EP; {$ENDC} 
001949 END; 

001950 

001951 


001952 {$8 DI gHot} 
001953 PROCEDURE TButton. MouseRel ease 
001954 BEGIN 


001955 {$1 FC fTrace}BP(11); {$ENDC} 

001956 TDi alog(SELF. parent). PushButton( SELF) 
001957 {$1 FC fTrace}EP; {$ENDC} 

001958 END; 

001959 

001960 


001961 {$8 DI gAll oc} 
001962 PROCEDURE TButton. Recal cExtent; 
001963 VAR dial ogView: TDi al ogVi ew 
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END 
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curWi dth: INTEGER; 
ti mesThrough: INTEGER 
next Button: TButton; 
legend: TLegend; 
paral mage: TParal mage; 
wi dth: INTEGER; 
stylelndex: INTEGER 
ol dLegendLoc: LPoint 
| RectTolnval: LRect; 
legLength: INTEGER 
text Di alogl mage: TText Di al ogl mage 
editLegendSel ection: TEdi tLegendSel ection; 
paraExtent: LRect; 
IN 
{$I FC fTrace}BP( 11); {$ENDC} 
|RectTolnval := SELF. extentLRect; 
legend := TLegend(SELF. children, First); 
oldLegendLoc := legend. | ocation; 


WTH legend.extentLRect DO 
legLength := right - left; 
WTH SELF, buttonMetrics DO 
-}  minWdth := MAX(absMnWidth, (legLength * expandNum) DIV expandDen); {$H+} 


curWdth := SELF. minWidth:; 
FOR timesThrough := 1 TO 2 DO 
BEGIN 
next Button := SELF. nextSameSi zedButton; 
WHILE nextButton <> SELF DO {send this round my circle of same-sized buttons} 
BEGIN 
next Button. Recompute(curWidth); 
WITH nextButton,extentLRect DO 
curWidth := right - left; 
nextButton := nextButton. nextSameSi zedButton; 
END; 
SELF. Recompute(curWidth); 
END; 


UnionLRect(|RectTolnval, SELF.extentLRect, | RectTolnval) 
IF TDialogView( SELF. view). isShowing THEN 
SELF. view. panel. I nvalLRect(IRectTolnval) 


IF SELF. parent <> NIL THEN 
SELF. parent, Recal cExtent; 
{$I FC fTrace}EP; {$ENDC} 
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002012 {$8 DI gAll oc} 
002013 PROCEDURE TButton. Recompute(minWdth: INTEGER); 


002014 VAR buttonWidth: INTEGER; 

002015 label Width: INTEGER; 

002016 legend: TLegend; 

002017 topLeft: LPoint; 

002018 shape: LRect; 

002019 offset: LPoint; 

002020 wi dt h: INTEGER; 

002021 curLegendWi dth: INTEGER; 

002022 textExtent: LRect; 

002023 topCenter: LPoint; 

002024 BEGIN 

002025 {$1 FC fTrace}BP(11); {$ENDC} 

002026 legend := SELF.|egend; 

002027 

002028 topLeft := SELF.extentLRect.topLeft; 

002029 WTH topCenter, SELF.extentLRect DO 

002030 BEGIN 

002031 v i= top; 

002032 h:= (left + right) DIV 2; 

002033 END; 

002034 

002035 buttonWdth := SELF. mnWdth; 

002036 IF buttonWdth < minWdth THEN 

002037 buttonWidth := minWdth; 

002038 

002039 Set ParaExtent(legend. paragraph, SELF.view, zeroLPt, textExtent); 
002040 curLegendWidth := textExtent. right; 

002041 

002042 SetLPt(offset, (topCenter.h ~- (curLegendWdth DIV 2)) - legend. location. h, 
002043 (topCenter.v + (( SELF. buttonMetrics. height DIV 2) + 3)) - legend.!ocation.v); 
002044 legend. Offset By(offset); 

002045 

002046 SetLRect(shape, 0, 0, buttonWidth, SELF. buttonMetrics. hei ght); 
002047 Of fSetLRect(shape, topCenter.h - (buttonWdth DIV 2), topCenter.v); 
002048 

002049 SELF. Resize(shape); 

002050 {$1 FC fTrace}EP; {$ENDC} 

002051 END; 

002052 

002053 


002054 {$$ DI gHot} 
002055 FUNCTION TButton. Still MyMouse( mouseLPt: LPoint): BOOLEAN; 
002056 {Called when the mouse which went down in me has moved; possibly it is no longer in me} 


002057 PROCEDURE TurnOff Button; 
002058 BEGIN 
002059 SELF. Hi ghl i ght( hOnToOff); 
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002060 END; 

002061 BEGIN 

002062 {$1 FC fTrace}BP(11); {$ENDC} 

002063 IF SELF. Hit(mouseLPt) THEN 

002064 Still MyMouse := TRUE {still in same button -- do nothing} 
002065 ELSE { no longer in the button ; need to unhilight and remove claim } 
002066 BEGIN 

002067 SELF. view. panel. OnAl| Pads Do( TurnOff Butt on) 

002068 Still MyMouse := FALSE; {see if anyone else wants this guy} 
002069 END ; 

002070 {$1 FC fTrace}EP; {$ENDC} 

002071 END; 

002072 

002073 


002074 {$8 Di gl nit} 

002075 END; 

002076 

002077 

Vitti Seer ce Ter ee ee ee eee ee re ee ee Sree cee eee ee are ee 
002079 

002080 

002081 METHODS OF TCheckbox; 

002082 

002083 

002084 {$8 DI gAll oc} 

002085 FUNCTION TCheckbox. CREATE(object: TObject; heap: THeap; itsld: $255; itsView: TView 


002086 itsLocation: LPoint; boxWdth: INTEGER; boxHei ght: INTEGER; wantLabel: BOOLEAN 
002087 label Offset: Point; itsTypeStyle: TTypeStyle): TCheckbox; 

002088 VAR extentLRect: LRect; 

002089 tempLRect: LRect; 

002090 rect! mage: TRectl mage 

002091 stringLoc: LPoint; 

002092 itsString: TLegend; 

002093 BEGIN 

002094 {$1 FC fTrace}BP(11); {$ENDC} 

002095 SetLRect(extentLRect, 0, 0, boxWidth, boxHei ght); 

002096 OffsetLRect(extentLRect, itsLocation.h, itsLocati on. v) 

002097 

002098 IF object = NIL THEN 

002099 object := NewObject(heap, THISCLASS) 

002100 SELF := TCheckbox(Tl mageWithI D. CREATE(object, heap, extentLRect, itsld, itsView, TRUE)); 
002101 

002102 SELF.isSelected := FALSE: 

002103 

002104 rectl mage := TRectIl mage.CREATE(NIL, heap, extentLRect, nolD, itsView, normal Pen, FALSE) 
002105 SELF. Addl mage(rectl mage); 

002106 SELF.rectl mage := rect! mage 

002107 
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002108 1F wantLabel THEN 

002109 BEGIN 

002110 itsString := NewStdLegend(SELF.Heap, itsID, extentLRect.right + label Offset. h, 
002111 extentLRect. bottom + labelOffset.v, itsView, itsTypeStyle) 
002112 SELF. Addl mage(itsString) 

002113 SELF.legend := itsString 

002114 END 

002115 ELSE 

002116 SELF.]egend := NIL; 

002117 {$1 FC fTrace}EP; {$ENDC} 

002118 END; 

002119 

002120 


002121 {$lFC fDebugMet hods} 

002122 {$8 DI gDbg} 

002123 PROCEDURE TCheckbox. Fields( PROCEDURE Field(nameAndType: $255)) 
002124 BEGIN 


002125 SUPERSELF. Fiel ds( Field) 

002126 Field('isSelected: BOOLEAN'); 
002127 Field('rectl mage: TRect! mage' ); 
002128 Field('legend: TLegend'); 
002129 Field(''); 


002130 END; 

002131 {$ENDC} 

002132 

002133 

002134 {$S DI gHot } 

002135 PROCEDURE TCheckbox. ChangeLabel (newS255: $255); 
002136 BEGIN 


002137 {$1 FC fTrace}BP(11); {$ENDC} 

002138 IF SELF.legend = NIL THEN 

002139 {$lFC fDbgOK} 

002140 ABCBreak('No legend to chg', 0) {later could perhaps launch a new | abel } 
002141 {$ENDC} 

002142 ELSE 

002143 SELF. legend. ChangeStri ng( newS255) 
002144 SELF. Recal cExtent; 

002145 {$1 FC fTrace}EP; {$ENDC} 

002146 END; 

002147 

002148 


002149 {$S DI gHot} 
002150 FUNCTION TCheckbox. CursorAt(mouseLPt: LPoint): TCursorNumber 
002151 BEGIN 


002152 {$1 FC fTrace}BP(11); {$ENDC} 
002153 IF SELF. Hit(mouseLPt) THEN 
002154 CursorAt := checkCursor 
002155 ELSE 
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002156 CursorAt := noCursor; 
002157 {$1 FC fTrace}EP; {$ENDC} 
002158 END; 

002159 

002160 


002161 {$$ DI gHot} 
002162 PROCEDURE TCheckbox. Draw 
002163 BEGIN 


002164 {$1 FC fTrace}BP(11); {$ENDC} 

002165 PenNor mal ; 

002166 IF SELF.IsSelected THEN 

002167 Fill LRect(SELF.rectl mage. extentLRect, | PatBl ack) {fill with black if selected} 
002168 ELSE 

002169 Fill LRect(SELF.rectl mage. extentLRect, | Pat White) 

002170 SELF. rect! mage. Draw; {draw the outline box in any case} 
002171 IF SELF.legend <> NIL THEN 

002172 SELF. | egend. Draw 

002173 {$1 FC fTrace}EP; {$ENDC} 

002174 END; 

002175 

002176 


002177 {$8 Di gLayout} 
002178 FUNCTION TCheckbox. LaunchLayout Box(view: TView): Tl mage 


002179 VAR | ayout Box: TLayout Box 

002180 childLayout Box: TLayout Box; 

002181 BEGIN 

002182 {$1 FC fTrace}BP(11); {$ENDC} 

002183 [F SELF.legend <> NIL THEN {has string; use normal layout box} 

002184 LaunchLayout Box := SUPERSELF. LaunchLayout Box( vi ew) 

002185 ELSE 

002186 BEGIN {a checkbox without an associated string} 

002187 childLayoutBox := TLayout Box( SELF. rectl mage. LaunchLayout Box( vi ew) ) 
002188 layoutBox := TLayoutBox. CREATE(NIL, SELF.Heap, childLayoutBox.extentLRect, nolD, NIL, 
002189 view, SELF, zeroRect, FALSE, FALSE, TRUE); 

002190 layout Box. Addl mage( chil dLayout Box) 

002191 LaunchLayout Box := layout Box; 

002192 END; 

002193 {$1 FC fTrace}EP; {$ENDC} 

002194 END; 

002195 

002196 


002197 {$S DI gHot} 

002198 PROCEDURE TCheckbox. MousePress(mouseLPt: LPoint); 

002199 {This proc is only called for mouspresses within "free check boxes", which is to say Checkboxes 

002200 which are componenents of a dialogView -- NOT for Checkboxes which are subdialogl mages of another dial ogl mage} 
002201 VAR carryOutTheToggle: BOOLEAN 

002202 di al ogView: TDi al ogVi ew 

002203 BEGIN 
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002204 {$1 FC fTrace}BP(11); {$ENDC} 

002205 carryOutTheToggle := TRUE; 

002206 dialogView := TDi al ogVi ew( SELF. view); 

002207 1F dialogView. paintFreeBoxes THEN {need to worry about only toggling if in current sense} 
002208 BEGIN 

002209 IF dialogView.startedPainting THEN {have already started ‘painting’ free checkboxes} 
002210 BEGIN 

002211 IF dialogView. paintSense = SELF.isSelected THEN 

002212 carryOutTheToggle := FALSE {already in the sense being painted--do nothing} 
002213 END 

002214 ELSE {just starting painting; establish the painting sense} 

002215 BEGIN 

002216 dialogView.startedPainting := TRUE; 

002217 dialogView. paintSense := NOT SELF.isSelected 

002218 END; 

002219 END; 

002220 IF carryOutTheToggle THEN 

002221 BEGIN 

002222 SELF. Toggle; 

002223 di alogView. panel. I nvalLRect( SELF. rect! mage. extentLRect); 

002224 SELF. Control Hit(SELF, SELF.isSelected); {pass it up to cluster and Dialog and even Dial ogVi ew} 
002225 END; 

002226 {$1 FC fTrace}EP; {$ENDC} 

002227 END; 

002228 

002229 


002230 {$5 DI gHot } 
002231 PROCEDURE TCheckbox. Toggle; 
002232 BEGIN 


002233 {$1 FC fTrace}BP(11); {$ENDC} 

002234 SELF.isSelected := NOT SELF.isSelected 
002235 {$1 FC fTrace}EP; {$ENDC} 

002236 END; 

002237 

002238 


002239 {$8 Diglnit} 

002240 END; 

002241 

002242 

0 22435 ii Siase che etera sh a6 BS tata ors wees Tana o, sta tenet asDrane cyciatate tiara vane ce ctaratsNa aveth ora Tavetac a a ieie care iOes clea level geeiare me clelayeld aihiane diam 4, aeestvaucleuarele ates 
002244 

002245 METHODS OF TCluster 

002246 

002247 

002248 {$8 DI gAll oc} 

002249 FUNCTION TCluster. CREATE(object: TObject; heap: THeap; itsld: $255; itsView: TView 
002250 itsLocation: LPoint): TCluster 

002251 VAR extentLRect: LRect; 
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002252 BEGIN 


002253 {$I FC fTrace}BP(11); {$ENDC} 

002254 WTH itsLocation DO 

002255 SetLRect(extentLRect, h, v, h + 1, v + 1); {include that pt in ultimate extent} 
002256 IF object = NIL THEN 

002257 object := NewObject(heap, THISCLASS) 

002258 SELF := TCluster(Tl mageWthilD.CREATE(object, heap, extentLRect, itsld, itsView, TRUE)) 
002259 

002260 WTH SELF DO 

002261 BEGIN 

002262 location := itsLocation; 

002263 hitBox := NIL; 

002264 hiLitBox := NIL; 

002265 last Box = NIL; 

002266 END; 

002267 {$1 FC fTrace}EP; {$ENDC} 

002268 END; 

002269 

002270 


002271 {$lFC fDebugMet hods} 

002272 {$8 DI gDbg} 

002273 PROCEDURE TCluster. Fields( PROCEDURE Field(nameAndType: $255) ) 
002274 BEGIN 


002275 SUPERSELF. Fiel ds( Field) 
002276 Field('location: LPoint') 
002277 Field('hitBox: TCheckBox' ); 
002278 Field('hiLitBox: TCheckBox'); 
002279 Field('lastBox: TCheckBox'); 
002280 Field(''); 


002281 END; 

002282 {$ENDC} 

002283 

002284 

002285 {$8 DI gAlloc} 

002286 FUNCTION TCluster. AddAli gnedCheckbox(itsld: $255; selectThisOne: BOOLEAN): TCheckbox; 
002287 CONST stdincrement = 20 


002288 VAR last Box: TCheckbox; 
002289 location: LPoint; 
002290 itsBoxWidth: INTEGER 
002291 it sBoxHei ght: INTEGER 
002292 checkBox: TCheckbox; 
002293 want Label: BOOLEAN 
002294 label Offset: Point; 
002295 vhs: VHSel ect; 
002296 itsTypeStyle: TTypeStyle 
002297 styl eChange: TStyl eChange 
002298 BEGIN 

002299 {$1 FC fTrace}BP(11); {$ENDC} 
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002300 itsTypeStyle := sysTypeStyle; 
002301 wantLabel := (itsID <> nolD); 
002302 label Offset := stdLabel Offset; 


002303 itsBoxWdth := stdBoxWdth; 

002304 itsBoxHei ght := stdBoxHei ght; 

002305 

002306 lastBox := SELF.]astBox; 

002307 IF lastBox = NIL THEN {this is the first to be inserted} 

002308 location := SELF.location 

002309 ELSE {there is already at least one box in the cluster -- align to right of it & use its params} 
002310 BEGIN 

002311 WITH location DO 

002312 BEGIN 

002313 h := lastBox.extentLRect.right + stdlncrement 

002314 v := lastBox.rectl mage. extentLRect. top; 

002315 END; 

002316 WITH lastBox.rectIl mage.extentLRect DO 

002317 BEGIN 

002318 itsBoxWdth := right - left; 

002319 itsBoxHeight := bottom- top; 

002320 END; 

002321 IF wantLabel THEN 

002322 BEGIN 

002323 IF lastBox.legend <> NIL THEN {use same type style and label Offset as prev guy} 
002324 BEGIN 

002325 lastBox. legend. paragraph. typeStyles.GetAt(1, @styl eChange) 
002326 WITH lastBox, legend DO 

002327 BEGIN 

002328 itsTypeStyle := styleChange. newStyle 

002329 FOR vhs := v TO h DO 

002330 label Offset. vh[ vhs] := location. vh[ vhs] - 

002331 rectl mage. extentLRect. botRi ght. vh[ vhs] 

002332 END; 

002333 END 

002334 ELSE 

002335 wantLabel := FALSE; {last box did not have a label, so | won't either} 
002336 END; 

002337 END; 

002338 

002339 checkBox := SELF. AddCheckbox(its!D, location, itsBoxWdth, itsBoxHei ght 
002340 wantLabel, labelOffset, itsTypeStyle, selectThisOne) 
002341 IF lastBox <> NIL THEN 

002342 checkbox.idNumber := |astBox.idNumber + 1; 

002343 AddAli gnedCheckbox := checkbox; 

002344 

002345 {$1 FC fTrace}EP; {$ENDC} 

002346 END; 

002347 
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002386 
002387 
002388 
002389 
002390 
002391 
002392 
002393 
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{$$ DI gAll oc} 
FUNCTION TCluster. NewAl i gnedCheckbox(itsPhrase: INTEGER; selectThisOne: BOOLEAN): TCheckbox; 
VAR itsID: $255; 
itsLocation: LPoint; 
checkbox: TCheckbox; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Get TextAndLocation(itsPhrase, itsID, itsLocati on) 
checkbox := SELF. AddAlignedCheckbox(its!D, selectThisOne); 
checkbox.idNumber := itsPhrase 
NewAl i gnedCheckbox := checkbox 
{$1 FC fTrace}EP; {$ENDC} 
END: 


{$$ DI gAll oc} 

FUNCTION TCluster. AddCheckbox(itsID: $255: itsLocation: LPoint; boxWdth: INTEGER; 
boxHei ght: INTEGER; wantLabel: BOOLEAN; label Offset: Point; 
itsTypeStyle: TTypeStyle; selectThisOne: BOOLEAN): TCheckbox; 

VAR location: LPoint; 
checkbox: TCheckbox: 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
checkbox := TCheckbox. CREATE(NIL, SELF.Heap, its!D, SELF.view, itsLocation, boxWidth, 
boxHei ght, wantLabel, labelOffset, itsTypeStyle); 
SELF. Addl mage( checkbox); 
SELF.| astBox := checkbox; 
IF selectThisOne THEN 
BEGIN 
IF NOT checkbox.isSelected THEN 
checkbox. Toggle; 
SELF. hiLitBox := checkbox; 
END; 
AddCheckbox := checkbox; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAll oc} 

FUNCTION TCluster. NewCheckbox(itsPhrase: INTEGER; boxWidth: INTEGER 
boxHei ght: INTEGER; wantLabel: BOOLEAN; label Offset: Point; itsTypeStyle: TTypeStyle 
selectThisOne: BOOLEAN): TCheckbox; 


VAR itsID: $255; 
itsLocation: LPoint; 
checkbox: TCheckbox; 

BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 
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002442 
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Get TextAndLocation(itsPhrase, itsID, itsLocation) 
checkbox := SELF. AddCheckbox(its!D, itsLocation, boxWdth, boxHeight, wantLabel, label Offset, 


itsTypeStyle, selectThisOne); 
checkbox.idNumber := itsPhrase 
NewCheckbox := checkbox; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gAl loc} 


PROCEDURE TCluster. AddRow0f Boxes( number Of Boxes: INTEGER; starting! DNumber: INTEGER 
boxWidth: INTEGER; boxHeight: INTEGER; boxSpacing: INTEGER); 


VAR current! DNumber: INTEGER 


checkbox: TCheckbox; 
newLocati on: LPoint; 
newl D: $255; 


BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 


FOR current! DNumber := startinglDNumber TO (starting! DNumber + numberOf Boxes - 


BEGIN 


IF SELF.| astBox = NIL THEN {this is the first to be inserted} 


newLocation := SELF.location 


ELSE { There is already at least one box in the cluster -- 


WITH newLocation DO 


BEGIN 

h := SELF.lastBox.rect!l mage. extentLRect.right + boxSpacing 
v := SELF. ]astBox.rectl mage. extentLRect. top; 

END; 


IntToString(current!DNumber, @newl D) 


1) DO 


align to right of it} 


{??} 


checkbox := SELF. AddCheckbox(newl D, newlLocation, boxWidth, boxHeight, FALSE, zeroPt, 


sysTypeStyle, FALSE); 
checkBox.!DNumber := current! DNumber 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
FUNCTION TCluster. Hit(mouseLPt: LPoint): BOOLEAN 
VAR checkbox: TCheckbox: 
Ss! TListScanner 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Hit := FALSE; 
IF LRectHasLPt(SELF.extentLRect, mouseLPt) THEN 
BEGIN 
s := SELF.children. Scanner: 
WHILE s.Scan(checkbox) DO 


{passes coarsest hit test; 
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002444 IF checkbox. Hit(mouseLPt) THEN 
002445 BEGIN 

002446 Hit := TRUE: 

002447 SELF. hitBox := checkbox; 
002448 s. Done; 

002449 END; 

002450 END; 

002451 {$1 FC fTrace}EP; {$ENDC} 

002452 END; 

002453 

002454 


002455 {$8 DI gHot} 
002456 PROCEDURE TCluster. MousePress(mouseLPt: LPoint); 


002457 {We are assured that when this is called, it will have been immedi atel y 
002458 preceded by a successful call to TCluster. Hit . Hence, the field 
002459 TCluster. hitBox will correctly point to which guy was hit. } 

002460 BEGIN 

002461 {$1 FC fTrace}BP(11); {$ENDC} 

002462 SELF.SelectBox(SELF.hitBox); {will deselect any other} 

002463 {$1 FC fTrace}EP; {$ENDC} 

002464 END; 

002465 

002466 


002467 {$S DI gHot} 
002468 PROCEDURE TCluster. SelectBox(checkbox: TCheckbox); {select this box, deselecting others} 
002469 PROCEDURE DrawUnHi Lit BoxOnThePad 


002470 BEGIN 

002471 SELF. hilitBox. Draw; {redraw old box unhilit} 

002472 END; 

002473 

002474 PROCEDURE DrawHi Lit BoxOnThePad 

002475 BEGIN 

002476 checkbox. Draw; {toggle the newly selected one on} 
002477 END; 

002478 BEGIN 

002479 {$1 FC fTrace}BP(11); {$ENDC} 

002480 IF (SELF. hiLitBox <> checkbox) AND (checkbox <> NIL) THEN 
002481 BEGIN 

002482 IF SELF. hiLitBox <> NIL THEN 

002483 BEGIN 

002484 SELF. hi LitBox. Toggle; 

002485 SELF. view. panel. OnAl | PadsDo( DrawUnHi Li t BoxOnThePad); 
002486 SELF. Control Hit (SELF. hiLitBox, FALSE) 

002487 END; 

002488 SELF. hiLitBox := checkbox; {set new box as the currently hilit one} 
002489 checkbox. Toggle; 

002490 SELF. view. panel. OnAl| Pads Do( DrawHi Lit BoxOnThePad); 
002491 SELF. Control Hit(checkbox, TRUE) 
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END; 
{$I FC fTrace}EP; {$ENDC} 
END: 
{$$ DI gHot} 
FUNCTION TCluster. Still MyMouse(mouseLPt: LPoint): BOOLEAN 
BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 

1F SELF. Hit(mouseLPt) THEN {mouse is in a box of the cluster} 
BEGIN 
SELF. Select Box( SELF. hit Box); {will toggle any alternate box off} 
Still MyMouse := TRUE; 
END 

ELSE {mouse not in any of my box's hit areas at the moment } 
Still MyMouse := FALSE; 

{$1 FC fTrace}EP; {$ENDC} 

END; 


{$$ Di gl nit} 
E ' 


METHODS OF TI nput Frame; 


{$$ DI gAll oc} 

FUNCTION Tinput Frame, CREATE(object: TObject; heap: THeap; itsid: $255; itsView: TView 
promptLocation: LPoint; promptTypeStyle: TTypeStyle; 
inputLocation: LPoint; inputTypeStyle: TTypeStyle; maxInputChars: INTEGER 
itsBorders: Rect; drawlnputLRect: BOOLEAN; drawHitLRect: BOOLEAN): Tl nputFrame 


VAR textExtent: LRect; 

my OwnExtentLRect: LRect; 
prompt: TLegend; 
text Di al ogl mage: TText Di al ogl mage 

{$1FC libraryVersion <= 20} {* ** PEPSI * * *} 
fl nfo: TFl nfo; 

{$ELSEC} {** §$PRING * *} 
fl nfo: FontI nfo; 

{$ENDC} 

BEGIN 


{$I FC fTrace}BP(11); {$ENDC} 
prompt := TLegend. CREATE(NIL, heap, itsID, itsView, promptLocation, promptTypeStyle); 


Set QDTypeStyl e(inputTypeStyle); 


Get Fonti nfo(finfo); 
WTH flnfo DO 
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SetLRect(textExtent, 0, -ascent - leading, maxi nputChars * widMax, descent + leading); 


OffsetLRect(textExtent, inputLocation.h, inputLocati on. v) 
textDialogl mage := TTextDialogl mage. CREATE( NIL, heap, textExtent, ‘input', itsView 
inputTypeStyle, ''); 


Uni onLRect(prompt.extentLRect, textDialoglmage.extentLRect, myOwnExtentLRect); 
LRectAddBorders(myOwnExtentLRect, itsBorders, myOwnExtentLRect); 


IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TinputFrame(Tl mageWithID.CREATE(object, heap, myOwnExtentLRect, itsld, itsView 


SELF. prompt := prompt; 
SELF. Addl mage( prompt); 


SELF. textDialogl mage := textDialogl mage 
SELF. Addl mage(text Dial ogl mage); 


SELF.inputTypeStyle := inputTypeStyle 
SELF. maxIl nputChars := maxi nputChars 
SELF. drawHitLRect := drawHitLRect; 
SELF. drawl nputLRect := drawl nputLRect; 
SELF. borders := itsBorders; 


{$I FC fTrace}EP; {$ENDC} 


{$1 FC fDebugMet hods} 


{$$ 


DI gDbg} 


PROCEDURE Tl nputFrame. Fields( PROCEDURE Field(nameAndType: $255)) 


BEGI 


END; 


N 

SUPERSELF. Fields(Field); 

Field('textDialogl mage: TTextDialogl mage'); 

Field('prompt: TLegend'); 

Field('borders: Rect'); 

Field('drawlnputLRect: BOOLEAN' ) 

Field('drawHitLRect: BOOLEAN'); 

Field('maxlnputChars: INTEGER’) 

Field('inputTypeStyle: LONGI NT'); {make this right someday} 
Field(''); 


{$ENDC} 


{$S 


DI gText } 


FUNCTION Ti nput Frame. CursorAt(mouseLPt: LPoint): TCursorNumber 


TRUE) ); 
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002602 
002603 
002604 
002605 
002606 
002607 
002608 
002609 
002610 
002611 
002612 
002613 
002614 
002615 
002616 
002617 
002618 
002619 
002620 
002621 
002622 
002623 
002624 
002625 
002626 
002627 
002628 
002629 
002630 
002631 
002632 
002633 
002634 
002635 
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BEGIN 
{$IFC fTrace}BP(11); {$ENDC} 
IF SELF. Hit(mouseLPt) THEN 
CursorAt := textCursor 
ELSE 
CursorAt := noCursor 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Dl gText} 
PROCEDURE Tl nputFrame. Draw 
VAR tempLRect: LRect; 
pat: pattern; 

BEGIN 

{$I1FC fTrace}BP(11); {$ENDC} 

IF SELF. prompt <> NIL THEN 
SELF. prompt. Draw, 

SELF. text Di al ogl mage. Draw; {draw the current input characters lying there... } 

[F SELF. drawl nputLRect THEN 
BEGIN 
tempLRect := SELF.textDialogl mage.textl mage. extentLRect; 
InsetLRect(tempLRect, -6, -4); 
PenNor mal 
thePad, LPatToPat(|PatGray, pat); 
PenPat (pat); 
PenSize(1,1); 
FrameLRect(tempLRect); {mostly for debugging reassurance... } 
END; 

|F SELF. drawHitLRect THEN 
FrameLRect(SELF.extentLRect); 

{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ Dl gLayout} 
FUNCTION TinputFrame.LaunchLayoutBox(view: TView): Tl mage 
{In the future, if there were one, we would want to allow resizing of the hit area during 
layout, and would here launch a special type of layout box, TlnptFrmLayoutBox, to do layout just right} 
VAR | ayout Box: TLayout Box 
layBoxExtent: LRect; 
S! TListScanner: 
childLayout Box: TLayout Box; 
newBorders: Rect; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
layoutBox := TLayoutBox(SUPERSELF,.LaunchLayoutBox(view)); {i.e., TlmageWthID's | aunch} 
WTH | ayoutBox. borders DO 
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002636 BEGIN 

002637 top := SELF. borders. top; 

002638 right := SELF.borders.right - right; 
002639 bottom := SELF. borders. bottom - bottom 
002640 left := SELF. borders.left - left; 
002641 END; 

002642 layout Box. Recal cExtent; 

002643 LaunchLayoutBox := | ayout Box; 

002644 

002645 {$1 FC fTrace}EP; {$ENDC} 

002646 END; 

002647 

002648 


002649 {$8 Di gText} 
002650 PROCEDURE TinputFrame. MousePress( mouseLPt: LPoint); 


002651 VAR frameSelection: TFrameSel ection; 

002652 BEGIN 

002653 {$1 FC fTrace}BP(11); {$ENDC} 

002654 LRectHaveLPt(SELF.textDialogl mage. textl mage.extentLRect, mouseLPt); 

002655 TDi al ogVi ew SELF. view). magnetCursor := textCursor 

002656 frameSelection := TFrameSel ection(SELF. view. panel.sel ection. FreedAndRepl acedBy( 
002657 TFrameSelection. CREATE(NIL, SELF.Heap, SELF))); 
002658 SELF. text Dial ogl mage. text! mage. MousePress( mouseLPt) 

002659 {$1 FC fTrace}EP; {$ENDC} 

002660 END; 

002661 

002662 


002663 {$8 Di gText} 
002664 PROCEDURE Ti nputFrame.GetContents(VAR theStr: $255); 


002665 VAR paral mage: TParal mage 
002666 paragraph: TParagraph; 
002667 BEGIN 

002668 {$1 FC fTrace}BP(11); {$ENDC} 
002669 paral mage := TParal mage(SELF.textDialogl mage. textl mage. i mageList. First); 
002670 paragraph := paral mage. paragraph; 
002671 paragraph, ToPStr( @theStr) 

002672 {$1 FC fTrace}EP; {$ENDC} 

002673 END; 

002674 

002675 


002676 {$8 Di gLayout} 
002677 PROCEDURE TinputFrame. Recal cExtent 


002678 VAR newExtent: LRect; 

002679 BEGIN 

002680 {$I1FC fTrace}BP(11); {$ENDC} 

002681 IF SELF. prompt <> NIL THEN 

002682 Uni onLRect(SELF.prompt.extentLRect, SELF. textDialogl mage.extentLRect, newExtent) 
002683 ELSE 
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002684 newExtent := SELF. textDi al ogl mage. extentLRect 
002685 LRectAddBorders(newExtent, SELF. borders, newExtent) 
002686 

002687 SELF. Resize(newExtent); 

002688 IF SELF. parent <> NIL THEN 

002689 SELF. parent. Recal cExtent; 

002690 

002691 {$I1FC fTrace}EP; {$ENDC} 

002692 END; 

002693 

002694 


002695 {$8 Di gText} 
002696 FUNCTION TinputFrame. Stil! MyMouse(mouseLPt: LPoint): BOOLEAN 


002697 {in this implementation, once the insertion point has been dropped, we don't give up 
002698 control even if user now strays outside our hit area} 

002699 BEGIN 

002700 {$IFC fTrace}BP(11); {$ENDC} 

002701 LRectHaveLPt(SELF.textDialogl mage.textl mage.extentLRect, mouseLPt); 

002702 SELF. view. panel, selection. coSelection. MouseMove(mouseLPt); {currently, just pass it on to the 
002703 text selection} 
002704 Still MyMouse := TRUE; 

002705 {$I1FC fTrace}EP; {$ENDC} 

002706 END; 

002707 

002708 


002709 {$8 Dil gText} 
002710 PROCEDURE TI nputFrame. Suppl antContents(newStr: $255); 


002711 VAR paragraph: TParagraph; 

002712 paral mage: TParal mage 

002713 textl mage: TTextl mage 

002714 ol dCount: INTEGER 

002715 BEGIN 

002716 {$1FC fTrace}BP(11); {$ENDC} 

002717 textl mage := SELF.textDialogl mage. text! mage 
002718 paral mage := TParal mage(textl mage. i mageList. First); 
002719 paragraph := paral mage. paragraph; 

002720 ol dCount := paragraph. size 

002721 paragraph, Repl PString(0, oldCount, @newStr); 
002722 

002723 paral mage.changed := TRUE; 

002724 paral mage. | nval LinesWith(0, MAXINT) 

002725 

002726 textl mage. Recomputel mages(actionNone, TRUE) 
002727 1F TDi alogView(SELF.view).isShowing THEN 
002728 SELF. view. panel. | nval LRect( SELF. text Di al ogl mage. extentLRect); 
002729 {$I1FC fTrace}EP; {$ENDC} 

002730 END; 

002731 
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002732 
002733 
002734 
002735 
002736 
002737 
002738 
002739 
002740 
002741 
002742 
002743 
002744 
002745 
002746 
002747 
002748 
002749 
002750 
002751 
002752 
002753 
002754 
002755 
002756 
002757 
002758 
002759 
002760 
002761 
002762 
002763 
002764 
002765 
002766 
002767 
002768 
002769 
002770 
002771 
002772 
002773 
002774 
002775 
002776 
002777 
002778 
002779 
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{$$ Dil gl nit} 
END; 


METHODS OF TLegend; 


{$$ TK2Start} 
FUNCTION TLegend. CREATE(object: TObject; heap: THeap; itsChars: $255; itsView: TView 
itsLocation: LPoint; itsTypeStyle: TTypeStyle): TLegend 
VAR itsExtent: LRect 
hei ght: INTEGER 
itsParagraph: TParagraph; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
itsParagraph := TParagraph. CREATE(NIL, heap, LENGTH(itsChars), itsTypeStyle) 
itsParagraph.InsPStrAt(1, @itsChars); 
SetParaExtent(itsParagraph, itsView, itsLocation, itsExtent) 


IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TLegend(TDialogl mage. CREATE(object, heap, itsExtent, nolD, itsView, FALSE)); 


WTH SELF DO 
BEGIN 
location := itsLocation; 
paragraph := itsParagraph; 


woul dBeDraggable := TRUE; 
usesSysFont := (itsTypeStyle.font.fontFamily = famSystem) 
END; 


{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gCol d} 
PROCEDURE TLegend. Free 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Free( SELF. paragraph) ; 
SUPERSELF. Free; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 


{$5 DI gDbg} 
PROCEDURE TLegend. Fields( PROCEDURE Field(nameAndType: $255)) 
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002780 BEGIN 


002781 SUPERSELF. Fiel ds( Field) 

002782 Field('location: LPoint') 

002783 Field('paragraph: TParagraph'); 
002784 Field('wouldBeDraggable: BOOLEAN' ) 
002785 Field('usesSysFont: BOOLEAN’ ) 
002786 Field(''): 


002787 END; 

002788 {$ENDC} 

002789 

002790 

002791 {$S DI gHot} 

002792 PROCEDURE TLegend. ChangeToPhrase(newPhrase: INTEGER); 


002793 VAR newString: $255; 

002794 BEGIN 

002795 {$1 FC fTrace}BP(11); {$ENDC} 

002796 process. GetAlert(newPhrase, newString) 
002797 SELF. ChangeString(newStri ng) 

002798 {$1 FC fTrace}EP; {$ENDC} 

002799 END; 

002800 

002801 


002802 {$S DI gHot } 
002803 PROCEDURE TLegend. ChangeString(newString: $255); 
002804 BEGIN 


002805 {$1 FC fTrace}BP(11); {$ENDC} 

002806 SELF. view. panel. I nvalLRect(SELF.extentLRect); {invalidate old string's bounding box} 
002807 SELF. paragraph. Del Al | 

002808 SELF. paragraph. I nsPStrAt(1, @newString) 

002809 SELF. Get BoxRi ght; 

002810 SELF. view. panel. I nvalLRect(SELF.extentLRect); {invalidate new string's bounding box} 
002811 {$1 FC fTrace}EP; {$ENDC} 

002812 END; 

002813 

002814 


002815 {$8 DI gHot} 
002816 PROCEDURE TLegend. Draw 
002817 BEGIN 


002818 {$1 FC fTrace}BP(11); {$ENDC} 

002819 MoveToL(SELF.location.h, SELF.| ocation.v) 
002820 SELF. paragraph. Draw(1, SELF. paragraph. size) 
002821 {$1 FC fTrace}EP; {$ENDC} 

002822 END; 

002823 

002824 


002825 {$$ TK2Start} 
002826 PROCEDURE TLegend. Get BoxRi ght; 
002827 VAR newExtent: LRect; 
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002828 
002829 
002830 
002831 
002832 
002833 
002834 
002835 
002836 
002837 
002838 
002839 
002840 
002841 
002842 
002843 
002844 
002845 
002846 
002847 
002848 
002849 
002850 
002851 
002852 
002853 
002854 
002855 
002856 
002857 
002858 
002859 
002860 
002861 
002862 
002863 
002864 
002865 
002866 
002867 
002868 
002869 
002870 
002871 
002872 
002873 
002874 
002875 
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BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
Set ParaExtent(SELF. paragraph, SELF.view, SELF.]ocation, newExtent); 
SELF. Resize(newExtent); 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
PROCEDURE TLegend. GetString(VAR itsString: $255); 
BEGIN 
{$I FC fTrace}BP(11); {$ENDC} 
SELF. paragraph. ToPStr( @itsString); 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ SglLayout} 
FUNCTION TLegend. LaunchLayout Box(view: TView): Tl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
IF SELF.isEditable THEN 
LaunchLayoutBox := TLegendLayoutBox. CREATE(NIL, SELF.Heap, view, SELF) 
ELSE 
LaunchLayout Box := SUPERSELF. LaunchLayout Box( vi ew) 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 

PROCEDURE TLegend. Offset By(deltaLPt: LPoint); 

BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 

{$H-} LPtPlusLPt(SELF.location, deltaLPt, SELF.Jocation); {$H+} 
SUPERSELF. Offset By(deltaLPt); 
{$1 FC fTrace}EP; {$ENDC} 

END; 


{$$ DI gHot} 
PROCEDURE TLegend. Recal cExtent; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SELF. Get BoxRi ght; 
IF SELF. parent <> NIL THEN 
SELF. parent. Recal cExtent; 
{$1 FC fTrace}EP; {$ENDC} 
END; 
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002876 
002877 
002878 
002879 


End of 


{$$ Di gl nit} 
END; 
File -- Lines: 
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2879 Characters: 81055 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


{UDi al 0g3} 


(* 


{COPYRIGHT 1984 BY APPLE COMPUTER, | NC} 


TPi cObj ect 


TPl anner View - 


- TRectl mage -- TTextDialogl mage - TFrameSelection 
TLayoutBox - TLegendLayoutBox - ButtonLayoutBox - TTitleTab - 


TLayPickSelection - TLayMoveCommand - TEditLegendSelection ~- TDial ogDesi gnWindow 


ml 
{04/25/84 


{04/25/84 
{04/23/84 


{04/17/84 


{04/17/84 
{04/15/84 
{01/29/84 
{12/22/83 


1610 


0015 
1210 


2130 


2000 
2000 
1754 
1927 


Switched back to using a paralmage in call to FilterAndDo, as per JKD's latest change 
in TLegendLayout Box. Recal cExtent 

Removed the inval in TLegendLayout Box. MousePress, fExperimenting or not} 

Added TEditLegendSelection. MousePress, MouseMove and MouseRelease and field tripleClick 
to trap triple-click and do a SelectAll with it} 

Removed all references to 'underEdit' field of TDialogl mage 

TEditLegendSelection. Deselect, Free, and Restore changed 

Removed some commented-out code and some unused VAR declarations in the TEditLegendSe 
methods changed} 

In TEditLegendSelection. CREATE doesn't inval unless fExperi menting 

Removed ABCBreak calls in TEditLegendSel ection. CREATE, TFrameSel ection. KeyChar 

TLegendLayout Box. Draw always keys on existence of SELF.textDialogl mage, ignoring 

underEdit flag; underEdit, if this is okay, can vanish completely fromthe architecture} 

In TLegendLayout Box. RecalcExtent, try to use Tlmage. FilterAndDo correctly} 

Spring Prelim Rel ease} 

RELEASE TK8D} 

RELEASE TK8A} 


METHODS OF TPicObj ect; 


{$$ DI gCol d} 
FUNCTION TPicObject.CREATE(object: TObject; heap: THeap; itsid: $255; 
itsView: TView; itsLocation: LPoint; itsPicHandle: PicHandle): TPicObject; 


VAR tempHz: 


framel nVi ew 
my Pi cHandl e: 


THeap; 
LRect; 
Pi cHandle: 


boxAtCreation: Rect; 


BEGIN 


{$1 FC fTrace}BP(7); {$ENDC} 

boxAtCreation: = itsPicHandle**. picFrame 

noPad. rect ToLRect(boxAtCreation, framel nView); 
OffsetLRect(framelnView, itsLocation.h, itsLocation.v); 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 
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IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 


SELF := TPicObject(Tl mageWthID. CREATE(object, heap, framelnView, itsld 


SELF.isEditable := FALSE; 
SELF. boxAtCreation := boxAtCreation; 
Get Heap(tempHz) ; 
Set Heap( SELF. Heap); 
myPicHandle := OpenPicture(SELF. boxAtCreati on); 
SELF. picture := myPicHandle; 
DrawPicture(itsPicHandle, SELF. boxAtCreation); 
ClosePicture; 
Set Heap(tempHz) ; {restore normal heap} 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gCol d} 
PROCEDURE TPicObj ect. Free 
BEGIN 
{$1 FC fTrace}BP(7); {$ENDC} 
Kill Picture(SELF. picture); 
SUPERSELF. Free; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 


{$5 Dl gDbg} 

PROCEDURE TPicObject.Fields(PROCEDURE Field(nameAndType: $255)); 

BEGIN 
SUPERSELF. Fields(Field); 
Field('picHandle: LONGINT'); 
Field('boxAtCreation: Rect'); 
Field(''); 

END; 

{$ENDC} 

{$$ DI gCol d} 

PROCEDURE TPicObj ect. Draw 


VAR boxOnPad: 
BEGIN 
{$1FC fTrace}BP(7); {$ENDC} 
thePad. LRectToRect(SELF.extentLRect, boxOnPad); 
DrawPicture(SELF. picture, boxOnPad); 
{$1FC fTrace}EP; {$ENDC} 
END; 


Rect; 
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itsView, FALSE {no children})); 


{replay the incoming picture file onto our own heap} 
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000092 
000093 
000094 
000095 
000096 
000097 
000098 
000099 
000100 
000101 
000102 
000103 
000104 
000105 
000106 
000107 
000108 
000109 
000110 
000111 
000112 
000113 
000114 
000115 
000116 
000117 
000118 
000119 
000120 
000121 
000122 
000123 
000124 
000125 
000126 
000127 
000128 
000129 
000130 
000131 
000132 
000133 
000134 
000135 
000136 
000137 
000138 
000139 
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{$$ Dil gl nit} 
END; 


METHODS OF TRect! mage; 


{$$ DI gAll oc} 
FUNCTION TRectl mage. CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsld: $255; 
itsView: TView; itsPenState: PenState; withChildren: BOOLEAN): TRectl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 


SELF := TRectl mage(TDialogl mage. CREATE(object, heap, itsExtent, itsld, itsView, withChildren)); 


SELF. penState := itsPenState 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$5 DI gDbg} 
PROCEDURE TRectI mage. Fields(PROCEDURE Field(nameAndType: $255)); 
BEGIN 
SUPERSELF. Fields(Field); 
Field(CONCAT('penState: RECORD pnLoc: Point; pnSize: Point; pnMode: INTEGER;', 


‘pnPat: ARRAY[0..7] OF Byte END')); {actually a packed array--fix} 
Field(''); 
END; 
{$ENDC} 
{$$ DI gHot} 
PROCEDURE TRectl mage. Draw 
BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 
SetPenState(SELF.penState); {could first want to scale the pen size, via the Pad... } 
FrameLRect(SELF.extentLRect); 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ Dl gLayout} 
FUNCTION TRectI mage. LaunchLayoutBox(view: TView): Tl mage 
VAR newBox: TLayout Box; 
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000140 BEGIN 


000141 {$1 FC fTrace}BP(11); {$ENDC} 

000142 newBox := TLayoutBox. CREATE(NIL, SELF.Heap, SELF.extentLRect, nolD, NIL, 
000143 view, SELF, stdThinBorders, TRUE, TRUE, FALSE) 

000144 LaunchLayoutBox := newBox; 

000145 {$1 FC fTrace}EP; {$ENDC} 

000146 END; 

000147 

000148 


000149 {$8 Diglnit} 

000150 END; 

000151 

000152 

O00 TSS derteieics eric letcs iec toate ease sonee eee tater sie elan erate tee cia eine eed ern aes 
000154 

000155 

000156 METHODS OF TTextDi al ogl mage 

000157 

000158 

000159 {$8 Di gText} 

000160 FUNCTION TTextDialogl mage. CREATE(object: TObject; heap: THeap; itsExtent: LRect; itsld: $255; 


000161 itsView: TView; itsTypeStyle: TTypeStyle; itsInitial Chars: $255): TTextDial ogl mage 
000162 VAR textimage: TTextl mage 

000163 edit Para: TEdit Para 

000164 paraFormat: TParaFormat; 

000165 BEGIN 

000166 {$1 FC fTrace}BP(11); {$ENDC} 

000167 IF object = NIL THEN 

000168 object := NewObject(heap, THISCLASS) 

000169 SELF := TTextDialogl mage(TIl mageWthID. CREATE(object, heap, itsExtent, itsld, itsView, FALSE)); 
000170 

000171 textl mage := TTextl mage. CREATE(NIL, heap, itsView, itsExtent, 

000172 TText. CREATE(NIL, heap, TDialogView(itsView).styleSheet), TRUE) 

000173 

000174 textl mage.text.txtl mgList. | nsLast(textl mage) 

000175 

000176 paraFormat := TParaFormat.CREATE(NIL, heap, NIL); 

000177 paraFormat.dfltTStyle := itsTypeStyle 

000178 

000179 editPara := TEditPara. CREATE(NIL, heap, 0, paraFormat); 

000180 

000181 textl mage. i mageList.InsLast(textl mage. NewParal mage(editPara, itsExtent, 0, 0)) 
000182 textl mage. text. paragraphs. I nsLast(editPara) 

000183 editPara. Repl PString(0, editPara.size, @itsInitial Chars); 

000184 

000185 SELF. textl mage := textl mage 

000186 textl mage. Recomputel mages(actionNone, TRUE) 

000187 SELF. woul dBeDraggable := TRUE; 
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000188 SELF.refCount := 1: 
000189 {$1 FC fTrace}EP; {$ENDC} 
000190 END; 

000191 

000192 


000193 {$8 SgTxtRes} 
000194 PROCEDURE TText Dial og! mage. Free 
000195 BEGIN 


000196 {$1 FC fTrace}BP(11); {$ENDC} 
000197 SELF. text! mage. text. Free 
000198 SUPERSELF. Free 

000199 {$1 FC fTrace}EP; {$ENDC} 
000200 END; 

000201 

000202 


000203 PROCEDURE TText Dial ogl mage. ChangeRef Count By(delta: | NTEGER) 
000204 BEGIN 


000205 {$1 FC fTrace}BP(11); {$ENDC} 

000206 SELF.refCount := SELF.refCount + delta; 
000207 IF SELF.refCount <= 0 THEN 

000208 SELF. Free; 

000209 {$1 FC fTrace}EP; {$ENDC} 

000210 END; 

000211 

000212 


000213 {$lFC fDebugMet hods} 

000214 {$S DI gDbg} 

000215 PROCEDURE TTextDialogl mage. Fields(PROCEDURE Field(nameAndType: $255)); 
000216 BEGIN 


000217 SUPERSELF. Fiel ds( Field) 

000218 Field('textl mage: TTextl mage'); 
000219 Field('wouldBeDraggable: BOOLEAN' ) 
000220 Field('refCount: I NTEGER'); 

000221 Field(''); 

000222 END; 

000223 {$ENDC} 

000224 

000225 


000226 {$S DI gHot} 
000227 FUNCTION TText Dialog! mage. CursorAt(mouseLPt: LPoint): TCursorNumber 
000228 BEGIN 


000229 {$1 FC fTrace}BP(11); {$ENDC} 
000230 IF SELF. Hit(mouseLPt) THEN 
000231 CursorAt := textCursor 
000232 ELSE {not mine} 

000233 CursorAt := noCursor; 
000234 {$1 FC fTrace}EP; {$ENDC} 
000235 END; 
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000236 

000237 

000238 {$S SgTxtRes} 

000239 PROCEDURE TText Di al og! mage. Draw 
000240 BEGIN 


000241 {$1 FC fTrace}BP(11); {$ENDC} 
000242 SELF. text! mage. Draw 

000243 {$1 FC fTrace}EP; {$ENDC} 
000244 END; 

000245 

000246 


000247 {$8 Di gLayout} 
000248 FUNCTION TTextDialogl mage. LaunchLayoutBox(view: TView): Tl mage 


000249 VAR borders: Rect 

000250 newBox: TLayout Box; 

000251 BEGIN 

000252 {$1 FC fTrace}BP(11);{$ENDC} {dubious--formerly intended uses in abeyance} 
000253 [F SELF. wouldBeDraggable THEN 

000254 borders := stdPlainBorders 

000255 ELSE 

000256 borders := zeroRect; 

000257 newBox := TLayoutBox. CREATE(NIL, SELF.Heap, SELF.extentLRect, nolD, NIL {parent}, 
000258 view, SELF, borders, FALSE, FALSE, FALSE) 

000259 newBox. woul dMakeSel ection := TRUE; 

000260 newBox. SuppressDrawingMani pulee := FALSE; 

000261 newBox.isDraggable := SELF. woul dBeDraggable; 

000262 LaunchLayoutBox := newBox; 

000263 {$1 FC fTrace}EP; {$ENDC} 

000264 END; 

000265 

000266 


000267 {$8 SgTxtRes} 
000268 PROCEDURE TTextDialogl mage. MousePress(mouseLPt: LPoint); 
000269 BEGIN 


000270 {$1 FC fTrace}BP(11); {$ENDC} 

000271 SELF. text! mage. MousePress( mouseLPt ) 
000272 {$1 FC fTrace}EP; {$ENDC} 

000273 END; 

000274 

000275 


000276 {$8 SgTxtRes} 
000277 PROCEDURE TText Dial ogl mage. OffsetBy(deltaLPt: LPoint); 
000278 BEGIN 


000279 {$1 FC fTrace}BP(11); {$ENDC} 
000280 SELF. text! mage. Offset By(deltaLPt) 
000281 SUPERSELF. Offset By(deltaLPt) 
000282 {$1 FC fTrace}EP; {$ENDC} 

000283 END; 
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{$$ Di gl nit} 
END; 


METHODS OF TFrameSel ection; 


{$$ DI gHot } 
FUNCTION TFrameSel ection. CREATE(object: TObject; heap: THeap; 
itslnputFrame: TinputFrame): TFrameSel ection; 
VAR coSelecti on: TSelection; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TFrameSelection(TSelection. CREATE(object, heap, itsIlnputFrame. view 
frameKind, zeroLPt)); 


SELF.inputFrame := itsIlnputFrame; 
SELF. boundLRect := itsInputFrame. text Dial ogl mage. extentLRect; 
coSelection := itsIlnputFrame. view. NoSelection; {put non-NIL coSel ection} 


SELF. coSelection := coSelection; 
{$I FC fTrace}EP; {$ENDC} 
END: 


{$$ DI gHot} 
FUNCTION TFrameSelection. CanDoCommand(cmdNumber: TCmdNumber; VAR checkit: BOOLEAN): BOOLEAN 
BEGIN 
{$1 FC fTrace}BP( 10); {$ENDC} 
CASE cmdNumber OF 
uModern, uClassic,u20Pitch, ul5Pitch, ul2Pitch, wl0Pitch, ul2Point, ul4Point, ul8Point, 
uPlain, uBold, ultalic, uUnderline, uShadow, uOutline: 
CanDoCommand := FALSE; {before coSelection could set to TRUE} 


OTHERW SE 
CanDoCommand : = SUPERSELF. CanDoCommand(cmdNumber, checklt); 


END; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
PROCEDURE TFrameSel ection. KeyChar(ch: CHAR); 
VAR paral mage: TParal mage; 
maxCharsString: $255; 
BEGIN 


u24Poi nt, 
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{$1 FC fTrace}BP(11); {$ENDC} 
paral mage := TParal mage(SELF.inputFrame.textDialogl mage. text! mage. i mageList. First); 
[F (SELF.inputFrame. maxlnputChars > paral mage. paragraph.size) OR 
(NOT InClass(SELF.coSelection, TinsertionPoint)) THEN {can accept more} 
SELF. coSel ection. KeyChar(ch) 
ELSE 
BEGIN 
IntToStr(SELF.inputFrame. maxi nputChars, @maxCharsString) 
process.ArgAlert(1, maxCharsString); 
process. Stop( phTooManyChars); 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
PROCEDURE TFrameSelection. KeyEnter(dh, dv: INTEGER) 
BEGIN 

{$1 FC fTrace}BP(11); {$ENDC} 

IF (dh <> 0) OR (dv <> 0) THEN 

SELF. KeyTab((dh < 0) OR (dv < 0)); {right and down keys are Forward} 

{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot} 
PROCEDURE TFrameSel ection. KeyReturn; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
SELF. KeyTab( FALSE); 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
PROCEDURE TFrameSel ection. KeyTab(fBackward: BOOLEAN); 
VAR dial ogView: TDi al ogVi ew 
dialog! mage: TDi al ogl mage 
S! TListScanner; 
passedGo: BOOLEAN 
foundSuccessor: BOOLEAN 
previnputFrame: Ti nput Frame; 
nexti nputFrame: Ti nputFrame; 
newFrameSel: TFrameSel ection; 
dialog: TDi al og; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
dialogView := TDi al ogVi ew( SELF. view); 
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000380 previnputFrame := NIL; 

000381 passedGo := FALSE; 

000382 foundSuccessor := FALSE; 

000383 dialog := TDialog(SELF.input Frame. parent) 

000384 s := dialog. children. Scanner 

000385 WHILE s.Scan(dialogl mage) DO 

000386 BEGIN 

000387 1F dialogl mage = SELF.inputFrame THEN {found current frame} 
000388 BEGIN 

000389 IF not fBackward THEN 

000390 passedGo := TRUE 

000391 ELSE {back-tab; use most recent input frame, if any} 
000392 BEGIN 

000393 IF previnputFrame = NIL THEN {there is none; can't do anything} 
000394 s.Done {with foundSuccessor still FALSE} 
000395 ELSE {found somebody! } 

000396 BEGIN 

000397 nextIi nputFrame := previ nput Frame; 

000398 foundSuccessor := TRUE; 

000399 END; 

000400 END; 

000401 END; 

000402 IF InClass(dialogl mage, TinputFrame) THEN 

000403 IF (passedGo AND (dialogl mage <> SELF.inputFrame)) OR foundSuccessor THEN 
000404 BEGIN 

000405 IF passedGo THEN 

000406 nexti nputFrame := TinputFrame(dialogl mage); {else it's already set, if back-tab} 
000407 SELF. KeyPause 

000408 

000409 dialog. SelectI nputFrame( next! nput Frame) 

000410 

000411 foundSuccessor := TRUE; 

000412 s. Done; 

000413 END {forward tabbing actually done} 

000414 ELSE 

000415 previnputFrame := Til nputFrame(dialogl mage); 
000416 END; {scan of dial ogl mages} 

000417 1F NOT foundSuccessor THEN 

000418 SELF. Cant Dolt; 

000419 {ELSE 

000420 SELF. wi ndow. Commi tLast}; 

000421 {$1 FC fTrace}EP; {$ENDC} 

000422 END; 

000423 

000424 


000425 {$8 DI gHot} 
000426 PROCEDURE TFrameSel ection. MousePress(mouseLPt: LPoint); 
000427 {called only if mouse comes BACK down inside alredy-selected Input Frame} 
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BEGIN 
{$I FC fTrace}BP(11); {$ENDC} 
SUPERSELF. MousePress(mouseLPt); 


TDi al ogVi ew(SELF. view). magnetCursor := textCursor 
{$1 FC fTrace}EP; {$ENDC} 
END; 
{$$ DI gHot } 
PROCEDURE TFrameSel ection. PerformCommand(command: TCommand; cmdPhase 
VAR paragraph: TParagraph; 
textl mage: TTextl mage 
paral mage: TParal mage 
noSel ection: TSelection; 
BEGIN 


{$1 FC fTrace}BP(11); {$ENDC} 

textl mage := SELF.input Frame. text Di al ogl mage. textl mage 
SUPERSELF. PerformCommand(command, cmdPhase) 

paral mage := TParal mage(textl mage. i mageList. First); 
paragraph := paral mage. paragraph; 


TCmdPhase); 


paragraph. NewStyle(0, paragraph. Size, SELF.inputFrame.inputTypeStyl e); 


IF paragraph.size > SELF.inputFrame. maxi nputChars THEN 
BEGIN {may need temp para here} 


paragraph. Repl Para(0, paragraph.size, paragraph, 0, SELF.inputFrame. max! nput Chars); 


paral mage.changed := TRUE; 

paral mage. I nvalLinesWith(0, MAXINT); 

textl mage. Recomputel mages(actionNone, TRUE); 
SELF. wi ndow. Commi tLast; 


noSelection := SELF. FreedAndRepl acedBy( SELF. view. NoSel ection); 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ DI gHot } 
PROCEDURE TFrameSel ection. Restore 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
TDi al ogVi ew(SELF. view). currentDialogl mage := SELF.input Frame 
SUPERSELF. Restore; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ Dil gl nit} 
E ' 
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METHODS OF TPlannerVi ew 


{$$ Sglayout} 

FUNCTION TPlannerView. CREATE(object: TObject; heap: THeap; itsViewBeingPlanned: TView 
itsPanel: TPanel; itsAllowSketching: BOOLEAN; 
itsRetainPickedBox: BOOLEAN): TPlannerView 

VAR newList: TList; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TPlannerView( TDi alogView. CREATE( object, heap, itsViewBeingPl anned, extentLRect 
NIL, itsViewBeingPl anned.res)); 


WITH SELF DO 
BEGIN 
viewBeingPlanned := itsVi ewBei ngPl anned 
allowSketching := itsAll owSketching 
retainPickedBox := itsRetai nPickedBox: 
currentLayoutBox := NIL; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$S DI gDbg} 

PROCEDURE TPlannerView. Fields(PROCEDURE Field(nameAndType: $255)); 

BEGIN 
SUPERSELF. Fields( Field); 
Field('viewBeingPlanned: TView'); 
Field('allowSketching: BOOLEAN' ); 
Field('retainPickedBox: BOOLEAN' ) 
Field('currentLayoutBox: TLayoutBox'); 
Field(''); 

END; 

{$ENDC} 


{$$ SglLayout} 
FUNCTION TPlannerView. CursorAt(mouseLPt: LPoint): TCursorNumber 
VAR s: TListScanner: 
layoutBox: TLayout Box; 
curCursor: TCursorNumber 
BEGIN 
{$IFC fTrace}BP(11); {$ENDC} 
IF SELF.mouselsDown AND (SELF. magnetCursor <> noCursor) THEN 
CursorAt := SELF. magnet Cursor 


itsPanel, 
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ELSE 

BEGIN 

curCursor := noCursor 

s := SELF. rootDialog. children. Scanner 

WHILE s.Scan(layoutBox) DO 
BEGIN 
curCursor := | ayoutBox. CursorAt( mouseLPt); 
IF curCursor <> noCursor THEN 

s. Done 

END; 

CursorAt := curCursor 

END; 

{$I1FC fTrace}EP; {$ENDC} 
END: 


{$$ SglLayout} 
PROCEDURE TPlannerVi ew. Draw 
PROCEDURE DrawLayoutBox(obj: TObject); 
VAR | ayout Box: TLayout Box; 
BEGIN 
layoutBox := TLayout Box( obj); 
layout Box. Draw 
END; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. EachActual Part( DrawLayout Box); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Sglayout} 
PROCEDURE TPlannerView. EachActual Part( PROCEDURE DoToObject(filteredObj: TObject)); 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
SELF. root Dialog. children. Each( DoToObj ect); 
{$IFC fTrace}EP; {$ENDC} 


END; 
{$$ DI gAll oc} 
PROCEDURE TPlannerView. Init(itsListOfl mages: TList); 
VAR s: TListScanner: 

t: TListScanner: 
i mage: Tl mage; 
layout Box: TLayout Box; 
otherLayout Box: TLayout Box; 
next Button: TButton; 
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BEGIN 
{$1 FC fTrace}BP( 10); {$ENDC} 
IF itsListOfl mages <> NIL THEN 


BEGIN 
s := itsListOfl mages. Scanner; {create parallel structure} 
WHILE s.Scan(image) DO 

BEGIN 


layoutBox := SELF. NewLayout Box(i mage); 
IF layoutBox <> NIL THEN 
SELF. root Dialog. Addi mage(layoutBox); {it may well have its own children, already created} 


END; 
END; 
[F InClass(SELF.viewBeingPlanned, TDialogView) THEN {get buttonLayoutBoxes correctly entwined} 
BEGIN 
s := SELF. rootDialog. children. Scanner 


WHILE s.Scan(layoutBox) DO 
IF InClass(layoutBox, TButtonLayoutBox) THEN 


BEGIN 
nextButton := TButton(layout Box. mani pulee).nextSameSi zedButton; 
t := SELF. rootDialog. children. Scanner; 


WHILE t.Scan(otherLayoutBox) DO 
IF otherLayout Box. manipulee = nextButton THEN {found it} 


BEGIN 
TButtonLayout Box(|ayout Box). nextSameSizedBox := TButtonLayout Box(otherLayout Box) 
t. Done; 
END; 
END; 
END; 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$$ DI gAl loc} 
FUNCTION TPlanner View. NewLayout Box(image: Tl mage): TLayout Box; 
BEGIN 


{$1FC fTrace}BP( 10); {$ENDC} 

NewLayoutBox := TLayoutBox(i mage. LaunchLayout Box( SELF) ); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ Dl gLayout} 
PROCEDURE TPlannerView. MousePress(mouseLPt: LPoint); 


VAR panel: TPanel; 
layPickSel ection: TLayPickSel ection; 
pi ckedBox: TLayout Box; 


S! TListScanner: 
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000620 | ayout Box: TLayout Box; 

000621 madeSel ection: BOOLEAN 

000622 editLegendSel ection: TEdi tLegendSel ection; 

000623 PROCEDURE I nvrt OnThePad 

000624 BEGIN 

000625 pi ckedBox. Hi ghl i ght ( hOf f ToOn) 

000626 END; 

000627 BEGIN 

000628 {$1 FC fTrace}BP( 10); {$ENDC} 

000629 SELF. mouselsDown := TRUE; 

000630 SELF. magnetCursor := noCursor 

000631 panel := SELF. panel 

000632 madeSelection := FALSE; 

000633 IF (panel.selection. kind <> nothingKind) AND (panel.selection. kind <> layPickKind) THEN 
000634 BEGIN 

000635 IF clickState.fShift THEN 

000636 madeSelection := TRUE 

000637 ELSE 

000638 IF InClass(panel.selection, TEditLegendSelection) THEN 

000639 BEGIN 

000640 editLegendSelection := TEditLegendSel ection( panel. selection) 
000641 IF LPtinLRect(mouseLPt, editLegendSel ection. |egendLayout Box. extentLRect) THEN 
000642 1F NOT LPtInLRect(mouseLPt, editLegendSel ection. |egendLayout Box.titleTab.extentLRect) THEN 
000643 BEGIN 

000644 madeSelection := TRUE: 

000645 SELF. magnetCursor := textCursor 

000646 END; 

000647 END; 

000648 END; 

000649 

000650 IF madeSelection THEN 

000651 panel.selection. MousePress( mouseLPt ) 

000652 ELSE 

000653 BEGIN 

000654 panel. Begi nSel ection; 

000655 pickedBox := NIL; {find who wants the mouse} 

000656 s := SELF. rootDialog. children. Scanner 

000657 WHILE s.Scan(layoutBox) DO 

000658 BEGIN 

000659 layoutBox. ConsiderMouse(mouseLPt, madeSelection, pickedBox); 
000660 IF pickedBox <> NIL THEN 

000661 pickedBox. ComeFor ward 

000662 IF madeSelection THEN 

000663 s. Done 

000664 ELSE 

000665 IF (pickedBox <> NIL) THEN {got the title tab of somebody} 
000666 BEGIN 

000667 pickedBox. ChangeDragSt at e( TRUE) 
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layPickSelection := TLayPickSel ection( panel. selection. FreedAndRepl acedBy( 


TLayPickSelection. CREATE(NIL, SELF. Heap, 


mouseLPt))); 
panel. OnAl | PadsDo(I nvrt OnThePad); 
SELF. magnetCursor := arrowCursor; 
s. Done; 
END 
END; 


NB: Here, when/if we allow sketching in layout, we would add code like: 


IF pickedBox = NIL THEN 
[F SELF. allowSketching THEN 


LaySketchSelection := TLaySketchSel ection(panel.selection. FreedAndRepl acedBy( 


TLaySketchSelection. CREATE(NIL, SELF. Heap, 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


DI gLayout } 
PROCEDURE TPl annerVi ew. MouseMove(mouseLPt: LPoint); 
BEGIN 

{$I FC fTrace}BP( 11); {$ENDC} 

TView. MouseMove(mouseLPt); {do NOT do what TDialogView would do} 
{$1 FC fTrace}EP; {$ENDC} 
END; 


SgLayout } 
PROCEDURE TPI annerVi ew. MouseRel ease 
BEGIN 
{$IFC fTrace}BP(11); {$ENDC} 
SELF. mouselsDown := FALSE; 
SELF. magnetCursor := noCursor 


SELF, mouseLPt) ) ) 


TVi ew. MouseRel ease; {do NOT do what TDialogView would do except for the above} 


{$I1FC fTrace}EP; {$ENDC} 
END; 


DI gil nit} 


HODS OF TLayout Box; 


SgLayout } 


FUNCTION TLayout Box. CREATE(object: TObject; heap: THeap; baseExtent: LRect; 
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its!D: $255; 
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000716 itsParent: TLayoutBox; itsView: TView; itsManipulee: Tlmage; itsBorders: Rect 
000717 itsResizable: BOOLEAN; itsSuppression: BOOLEAN; withChildren: BOOLEAN): TLayout Box; 
000718 VAR itsTitleTab: TTitleTab 

000719 itsExtentLRect: LRect; 

000720 BEGI N 

000721 {$1FC fTrace}BP(11); {$ENDC} 

000722 LRectAddBorders(baseExtent, itsBorders, itsExtentLRect); 
000723 IF object = NIL THEN 

000724 object := NewObject(heap, THISCLASS) 

000725 SELF := TLayoutBox(Tl mageWthID.CREATE(object, heap, itsExtentLRect, itsID, itsView, withChildren)) 
000726 

000727 IF itsBorders.top = 0 THEN 

000728 itsTitleTab := SELF. NoTitl eTab( SELF. Heap) 

000729 ELSE 

000730 itsTitleTab := TTitleTab. CREATE(NIL, heap, SELF, ~- itsBorders.bottom~ itsBorders.top + 1, 
000731 its!D); 

000732 

000733 WITH SELF DO 

000734 BEGIN 

000735 parent := itsParent; 

000736 titleTab := itsTitleTab: 

000737 manipulee := itsMani pulee 

000738 suppressDrawi ngMani pulee := itsSuppression; 

000739 wouldMakeSelection := FALSE: 

000740 isResizable := itsResizable; 

000741 isDraggable := TRUE; 

000742 shouldFrame := TRUE; 

000743 borders := itsBorders 

000744 hasDraggee := FALSE; 

000745 END; 

000746 {$I1FC fTrace}EP; {$ENDC} 

000747 END; 

000748 

000749 

000750 PROCEDURE TLayout Box. Free 

000751 BEGIN 

000752 {$l FC fTrace}BP( 10); {$ENDC} 

000753 Free(SELF.titleTab); 

000754 SUPERSELF. Free 

000755 {$IFC fTrace}EP; {$ENDC} 

000756 END; 

000757 

000758 

000759 {$1 FC fDebugMet hods} 

000760 {$$ DI gDbg} 

000761 PROCEDURE TLayout Box. Fields( PROCEDURE Field(nameAndType: $255) ) 
000762 BEGIN 

000763 SUPERSELF. Fi elds(Fiel d) 


Apple Lisa ToolKit 3.0 Source Code Listing -- 444 of 1012 


000764 
000765 
000766 
000767 
000768 
000769 
000770 
000771 
000772 
000773 
000774 
000775 
000776 
000777 
000778 
000779 
000780 
000781 
000782 
000783 
000784 
000785 
000786 
000787 
000788 
000789 
000790 
000791 
000792 
000793 
000794 
000795 
000796 
000797 
000798 
000799 
000800 
000801 
000802 
000803 
000804 
000805 
000806 
000807 
000808 
000809 
000810 
000811 


Apple Lisa Computer Technical Information 


Field('manipulee: Tl mage'); 
Field('titleTab: TTitleTab' ) 
Field('suppressDrawingManipulee: BOOLEAN' ) 
Field('isResizable: BOOLEAN'); 

Field(' borders: Rect'); 
Field('wouldMakeSelection: BOOLEAN'); 
Field('isDraggable: BOOLEAN’); 
Field('shouldFrame: BOOLEAN' ) 
Field('hasDraggee: BOOLEAN' ) 


Field(''); 
END; 
{$8 SgLayout} 
{$ENDC} 


PROCEDURE TLayout Box. ChangeDragState(enteringDrag: BOOLEAN); 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
SELF. hasDraggee := enteringDrag 
|F SELF.parent <> NIL THEN 
IF InClass(SELF. parent, TLayoutBox) THEN 
TLayout Box( SELF. parent). ChangeDragState(enteri ngDrag); 
{$I1FC fTrace}EP; {$ENDC} 


PROCEDURE TLayoutBox. ConsiderMouse(mouseLPt: LPoint; VAR madeSelection: BOOLEAN 
VAR pickedLayoutBox: TLayoutBox); 
VAR s: TListScanner; 
layoutBox: TLayout Box 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
pickedLayout Box := NIL; 
madeSelection := FALSE; 
1F NOT SELF. Hit(mouseLPt) THEN 
{it ain't me} 
ELSE 
BEGIN 
IF LRectHasLPt(SELF.titleTab.extentLRect, mouseLPt) THEN 
BEGIN 
pickedLayoutBox := SELF; 
SELF. TabGrabbed; {so that page status dialog can react now} 
END 
ELSE 
IF SELF. woul dMakeSel ection THEN 
BEGIN 
madeSelection := TRUE: 
pickedLayoutBox := SELF; 
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SELF. MousePress( mouseLPt) 
END 
ELSE {not my title tab, and | myself don't make selections; how about it, kids?} 
BEGIN 
1F SELF.children <> NIL THEN 
BEGIN 
s := SELF.children. Scanner; 
WHILE s.Scan(layoutBox) DO 
BEGIN 
layout Box. ConsiderMouse(mouseLPt, madeSelection, pickedLayout Box) 
1F madeSelection OR (pickedLayoutBox <> NIL) THEN 
s. Done; 
END; 
END; 
END; 


END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


FUNCTION TLayout Box. CursorAt( mouseLPt: LPoint): TCursorNumber 
VAR s: TListScanner; 

layoutBox: TLayout Box; 

curCursor: TCursorNumber 


BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
curCursor := noCursor 
IF SELF. Hit(mouseLPt) THEN 
BEGIN 
IF SELF.titleTab <> NIL THEN 
IF SELF. titleTab. Hit(mouseLPt) THEN 
curCursor := arrowCursor 
IF curCursor = noCursor THEN 
IF SELF.children <> NIL THEN 
BEGIN 
s := SELF.children. Scanner; 
WHILE s.Scan(layoutBox) DO 
BEGIN 
curCursor := layout Box. CursorAt( mouseLPt) 
IF curCursor <> noCursor THEN 
s. Done; 
END; 
END; 
END; 
CursorAt := curCursor 
{$I1FC fTrace}EP; {$ENDC} 
END: 
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000860 

000861 

000862 PROCEDURE TLayout Box. Draw 

000863 PROCEDURE YouDraw(obj: TObj ect); 

000864 VAR dialogl mage: TDialogl mage 

000865 BEGIN 

000866 dialogl mage := TDialogl mage(obj); 

000867 IF dialoglmage.isActive THEN 

000868 dial ogl mage. Draw 

000869 END; 

000870 BEGIN 

000871 {$I1FC fTrace}BP(11); {$ENDC} 

000872 IF LRectIlsVisible(SELF.extentLRect) OR SELF. hasDraggee THEN 
000873 BEGIN 

000874 SELF. EachActual Part(YouDraw); 

000875 SELF. Draw) ust Me; 

000876 END; 

000877 {$I1FC fTrace}EP; {$ENDC} 

000878 END; 

000879 

000880 

000881 PROCEDURE TLayout Box. Draw ust Me 

000882 VAR titleTab: TTitl eTab; 

000883 BEGIN 

000884 {$lFC fTrace}BP( 10); {$ENDC} 

000885 IF LRectIlsVisible(SELF.extentLRect) THEN 

000886 BEGIN 

000887 titleTab := SELF.titleTab; 

000888 IF titleTab <> NIL THEN {currently every layout box MUST have a title tab, so this is 
000889 unnecessary} 

000890 1F NOT EmptyLRect(titleTab. extentLRect) THEN 
000891 titleTab. Draw 

000892 

000893 1F NOT SELF. suppressDrawi ngMani pulee THEN 
000894 IF SELF. manipulee <> NIL THEN 

000895 SELF. mani pul ee. Draw 

000896 

000897 PenNor mal 

000898 [F SELF.IsDraggable AND SELF.shouldFrame THEN 
000899 FrameLRect(SELF.extentLRect); {draw overall box} 
000900 END; 

000901 {$I1FC fTrace}EP; {$ENDC} 

000902 END; 

000903 

000904 

000905 PROCEDURE TLayout Box. FreeMani pul ee 

000906 BEGIN 

000907 {$1FC fTrace}BP( 10); {$ENDC} 
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Free( SELF. mani pul ee); 
SELF. mani pulee := NIL; 
{$1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TLayout Box. Highlight(highTransit: THighTransit); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF (SELF.titleTab <> NIL) THEN 
BEGIN 
InvrtLRect(SELF.titleTab. extentLRect); 
PenNor mal 
FrameLRect(SELF.titleTab. extentLRect); 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TLayout Box. MousePress(mouseLPT: LPoint); 
VAR l|ayoutBox: TLayout Box; 
S! TListScanner 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
IF SELF.children <> NIL THEN 
BEGIN 
s := SELF.children. Scanner 
WHILE s.Scan(layoutBox) DO 
IF layout Box. DownAt( mouseLPt) <> NIL THEN 
s. Done; 


END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TLayout Box. Move(deltaLPt: LPoint) 
VAR ol dLRect: LRect; 
newLRect: LRect; 
heading: THeadi ng; 
PROCEDURE I nval OnThePad 
BEGIN 
thePad. | nvalLRect(oldLRect); 
thePad. | nval LRect(newLRect); 
END: 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
oldLRect := SELF. extentLRect; 
SELF. Offset By(deltaLPt); 
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newLRect := SELF. extentLRect; 

SELF. view. panel. OnAl | Pads Do(I nval OnThePad) 
{$IFC fTrace}EP; {$ENDC} 
END: 


{$S DI gDbg} 
FUNCTION TLayout Box. NoTitleTab( heap: THeap): TTitleTab; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
NoTitleTab := TTitleTab. CREATE(NIL, heap, SELF, 0, nol D) 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$$ Sglayout} 


PROCEDURE TLayout Box. OffsetBy(deltaLPt: LPoint); 
BEGIN 

{$1FC fTrace}BP( 10); {$ENDC} 

|F SELF.manipulee <> NIL THEN 


SELF. mani pulee. Offset By(deltaLPt); {offset MY manipulee, but not 
my manipulee's OffsetBy wil 


SELF. OffsetLayout BoxBy(deltaLPt, TRUE); 
{$IFC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TLayout Box. OffsetLayoutBoxBy(deltaLPt: LPoint; textl mageAs Well: 


{does NOT offset mani pul ee} 
PROCEDURE YouOffset(obj: TObj ect); 
VAR layoutBox: TLayoutBox; 
BEGIN 
layoutBox := TLayout Box( obj); 
layout Box. OffsetLayoutBoxBy(deltaLPt, textl mageAs Well); 
END; 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
IF SELF.titleTab <> NIL THEN 
SELF. titleTab. Offset By(deltaLPt); 
{$H-} OffsetLRect(SELF.extentLRect, deltaLPt.h, deltaLPt.v); {$H+} 
SELF. EachActual Part(YouOffset); {tells children} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TLayout Box. Recal cExtent; 
VAR s: TListScanner; 
newExtent: LRect; 
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001004 | ayout Box: TLayout Box; 

001005 ol dExtent: LRect; 

001006 PROCEDURE I nval Ol dAndNew 

001007 BEGIN 

001008 thePad. I nval LRect (ol dExtent); 

001009 thePad. | nval LRect(newExtent); 

001010 END; 

001011 BEGIN 

001012 {$1 FC fTrace}BP( 3); {$ENDC} 

001013 ol dExtent := SELF. extentLRect; 

001014 newExtent := SELF. mani pulee.extentLRect; 

001015 

001016 1F SELF.children <> NIL THEN 

001017 IF SELF.children. Size > 0 THEN 

001018 BEGIN 

001019 newExtent := zeroLRect; 

001020 s := SELF. children. Scanner 

001021 WHILE s.Scan(layoutBox) DO 

001022 1F EmptyLRect(newExtent) THEN 

001023 newExtent := layoutBox. extentLRect 
001024 ELSE 

001025 Uni onLRect(newExtent, |ayoutBox.extentLRect, newExtent); 
001026 END; 

001027 

001028 LRectAddBorders(newExtent, SELF. borders, newExtent) 
001029 1F NOT equalLRect(oldExtent, newExtent) THEN 
001030 BEGIN 

001031 SELF. Resi ze(newExtent); 

001032 SELF. view. panel. OnAl | PadsDo(I nval Ol dAndNew) ; 
001033 END; 

001034 IF SELF.parent <> NIL THEN 

001035 SELF. parent. Recal cExtent; 

001036 {$I FC fTrace}EP; {$ENDC} 

001037 END: 

001038 

001039 

001040 PROCEDURE TLayout Box. Resi ze(newExtent: LRect); 

001041 VAR newTitleExtent: LRect; 

001042 titleTab: TTitleTab; 

001043 BEGIN 

001044 {SI FC fTrace}BP( 3); {$ENDC} 

001045 titleTab := SELF.titleTab; 

001046 

001047 IF titleTab <> NIL THEN 

001048 BEGIN 

001049 newTitleExtent := newExtent; 

001050 newTitleExtent. bottom:= newTitleExtent.top + 
001051 (titleTab.extentLRect. bottom~- titleTab.extentLRect.top); {i.e., preserve old height} 
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titleTab. Resize(newTitl eExtent); 
END; 
SUPERSELF. Resize(newExtentLRect); 


{$I1FC fTrace}EP; {$ENDC} 


PROCEDURE TLayout Box. TabGrabbed 
BEGIN 


{$lFC fTrace}BP( 10); {$ENDC} 
{$I FC fTrace}EP; {$ENDC} 


{$$ Dil gl nit} 


METHODS OF TLegendLayout Box; 


{$$ Sglayout} 
FUNCTION TLegendLayout Box. CREATE( object: TObj ect; 


): TLegendLayout Box; 


VAR itsTitleTab: TTitleTab; 
itsExtentLRect: LRect; 
my Borders: Rect; 


BEGIN 


{$I1FC fTrace}BP(11); {$ENDC} 

IF itsLegend. woul dBeDraggable THEN 
myBorders := stdPlainBorders 

ELSE 
myBorders := zeroRect; 

IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 


SELF := TLegendLayout Box(TLayoutBox. CREATE(object, heap, itsLegend.extentLRect, nolD, NIL, 


itsView, itsLegend, myBorders, FALSE, FALSE, FALSE)); 


WITH SELF DO 
BEGIN 
isDraggable := itsLegend. woul dBeDraggable; 
shouldFrame := itsLegend. woul dBeDraggabl e; 
textDialogl mage := NIL; 
wouldMakeSelection := TRUE; {client could override, somehow? } 


END; 
{$I1FC fTrace}EP; {$ENDC} 
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{$1 FC fDebugMet hods} 
{$S Dl gDbg} 
PROCEDURE TLegendLayout Box. Fields(PROCEDURE Field(nameAndType: $255) ) 
BEGIN 
SUPERSELF. Fields( Field); 
Field('textDialogl mage: TTextDi al ogl mage' ) 


Field(''); 
END; 
{$$ SgLayout} 
{$ENDC} 


FUNCTION TLegendLayout Box. CursorAt(mouseLPt: LPoint): TCursorNumber 
VAR curCursor: TCursorNumber; 


BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
curCursor := noCursor 


IF SELF. Hit(mouseLPt) THEN 
IF SELF. titleTab. Hit(mouseLPt) THEN 
curCursor := arrowCursor 
ELSE 
IF SELF. woul dMakeSelection THEN 
curCursor := textCursor 
CursorAt := curCursor 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TLegendLayout Box. Draw 


VAR titleTab: TTitleTab; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF LRectIlsVisible(SELF.extentLRect) THEN 


BEGIN 
[F SELF.isDraggable THEN 
SELF. titleTab. Draw 


[F SELF. textDialogl mage <> NIL THEN {+SW+} 
SELF. text Dial ogl mage. Draw 

ELSE 
SELF. mani pulee. Draw 


PenNor mal 
[F SELF. |sDraggable AND SELF.shouldFrame THEN 
FrameLRect(SELF.extentLRect); {draw overall box} 


END; 
{$I1FC fTrace}EP; {$ENDC} 
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END; 


PROCEDURE TLegendLayout Box. MousePress(mouseLPT: LPoint); 


VAR editLegendSel ection: TEditLegendSel ection; 
BEGIN 

{$I FC fTrace}BP( 11); {$ENDC} 

TPlannerView( SELF. view). magnetCursor := textCursor 


LRectHaveLPt(SELF. mani pulee.extentLRect, mouseLPt); 
editLegendSelection := TEditLegendSel ection(SELF.view. panel.sel ection. FreedAndRepl acedBy( 
TEditLegendSelection. CREATE(NIL, SELF.Heap, SELF, mouseLPT))); 
editLegendSel ection. text Dial ogl mage. MousePress(mouseLPt) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TLegendLayout Box. OffsetLayoutBoxBy(deltaLPt: LPoint; text! mageAsWell: BOOLEAN); 
{does NOT offset mani pul ee} 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
SUPERSELF. Of fsetLayout BoxBy(deltaLPt, textl mageAsWel |); 
1F NOT text! mageAsWel!l THEN 
deltaLPt.v := 0; {don't do it vertically} 
[F SELF.textDialogl mage <> NIL THEN 
SELF. text Dial ogl mage. Offset By(deltaLPt); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TLegendLayout Box. Recal cExtent; 


VAR newExtent: LRect; 
ol dExtent: LRect; 
paral mage: TParal mage; 
textDi al ogl mage: TText Di al ogl mage 
legPara: TParagraph; 
PROCEDURE I nval Ol dAndNew 
BEGIN 


thePad. | nval LRect(ol dExtent); 
thePad. I nval LRect (newExtent); 


END; 
PROCEDURE PourltBack(obj: TObj ect); 
VAR paragraph: TParagraph; 
BEGIN 
paragraph := TParal mage( obj). paragraph; 
legPara. Rep! Para(0, legPara.size, paragraph, 0, paragraph. size); 
END; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
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text Dialogl mage := SELF. text Di alogl mage 
IF textDialogl mage <> NIL THEN 
BEGIN 
paral mage := TParal mage(textDialogl mage.textl mage. imageList. First); 
legPara := TLegend( SELF. mani pul ee). paragraph; 
textDialogl mage. textl mage. FilterAndDo( paral mage, Pourlt Back) 


TLegend( SELF. mani pulee). Recal cExtent; 


ol dExtent : 
newExtent : 


= SELF. extentLRect; 
= SELF. mani pulee.extentLRect; 
LRectAddBorders(newExtent, SELF. borders, newExtent) 
1F NOT equalLRect(oldExtent, newExtent) THEN 
BEGIN 
SELF. Resi ze(newExtent); 
SELF. view. panel. OnAl | PadsDo(Inval Ol dAndNew) 
END; 


IF SELF. parent <> NIL THEN 
SELF. parent. Recal cExtent; 
{$IFC fTrace}EP; {$ENDC} 


nit} 


OF TButtonLayout Box; 


{$$ Dl gLayout} 
FUNCTION TButtonLayout Box. CREATE(object: TObject; heap: THeap; itsButton: TButton; 


BEGI 


END; 


itsView: TView): TButtonLayout Box; 
N 
{$1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TButtonLayoutBox(TLayoutBox. CREATE(object, heap, itsButton.extentLRect, itsButton.id, NIL, 
itsView, itsButton, stdlDBorders, FALSE, TRUE, TRUE)); 


SELF. nextSameSizedBox := SELF; {will be correctly set by TPlannerView. CREATE after all layout 
boxes made} 

SELF. oldLegendTopLeft := itsButton. legend. extentLRect.topLeft; 

SELF. Addl mage( TDi al ogl mage(itsButton. legend. LaunchLayout Box(itsView))) 

{$I1FC fTrace}EP; {$ENDC} 
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{$1 FC fDebugMet hods} 
{$5 DI gDbg} 
PROCEDURE TButtonLayout Box. Fields( PROCEDURE Field(nameAndType: $255)) 
BEGIN 
SUPERSELF. Fields( Field); 
Field('nextSameSizedBox: TButtonLayoutBox' ); 
Field('oldLegendTopLeft: LPoint'); 
Field(''); 
END; 
{$ENDC} 


DI gLayout } 


PROCEDURE TButtonLayoutBox. ConsiderMouse(mouseLPt: LPoint; VAR madeSel ection: 


VAR pickedLayoutBox: TLayoutBox); 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
pickedLayoutBox := NIL; 
madeSelection := FALSE; 
IF SELF. Hit(mouseLPt) THEN 
BEGIN 
pickedLayout Box := SELF; 
IF NOT LRectHasLPt(SELF.titleTab. extentLRect, mouseLPt) THEN 
{hit on interior -- hence, editing button text} 
BEGIN 
madeSelection := TRUE; 


BOOLEAN; 


LRectHaveLPt(TLayout Box(SELF.children. First). extentLRect, mouseLPt) 


SELF. MousePress( mouseLPt) 
END; 
END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


DI gLayout } 
FUNCTION TButtonLayout Box. CursorAt(mouseLPt: LPoint): TCursorNumber 
BEGIN 

{$I FC fTrace}BP(11); {$ENDC} 

1F NOT SELF. Hit(mouseLPt) THEN 


CursorAt := noCursor 

ELSE 

IF SELF.titleTab. Hit(mouseLPt) THEN 
CursorAt := arrowCursor 

ELSE 
CursorAt := textCursor: 


{$I1FC fTrace}EP; {$ENDC} 
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001292 END; 

001293 

001294 

001295 {$8 Di gLayout} 

001296 PROCEDURE TButtonLayout Box. Draw] ust Me 

001297 VAR s: TListScanner 

001298 layoutBox: TLayout Box; 

001299 BEGIN 

001300 {$I1FC fTrace}BP(11); {$ENDC} 

001301 IF LRectIlsVisible(SELF.extentLRect) THEN 

001302 BEGIN 

001303 SELF. titleTab. Draw 

001304 TButton( SELF. mani pulee).DrawjustMe; {draws just the roundRect; my child will draw the text} 
001305 PenNor mal 

001306 FrameLRect(SELF.extentLRect); {draw overall box} 
001307 END; 

001308 {$IFC fTrace}EP; {$ENDC} 

001309 END; 

001310 

001311 

001312 {$8 SgLayout} 

001313 PROCEDURE TButtonLayout Box. Offset By(deltaLPt: LPoint); 
001314 BEGIN 

001315 {$IFC fTrace}BP(11); {$ENDC} 

001316 SUPERSELF. Offset By(deltaLPt); 

001317 {$H-} LPtPlusLPt(SELF.oldLegendTopLeft, deltaLPt, SELF.oldLegendTopLeft); {$H+} 
001318 {$I1FC fTrace}EP; {$ENDC} 

001319 END; 

001320 

001321 

001322 {$8 Di gLayout} 

001323 PROCEDURE TButt onLayout Box. Recal cExtent; 

001324 VAR next Box: TButtonLayout Box; 

001325 oldLegendTopLeft: LPoint; 

001326 newLegendTopLeft: LPoint; 

001327 deltaLPt: LPoint; 

001328 | egendBox: TLegendLayout Box; 

001329 BEGIN 

001330 {$I1FC fTrace}BP(11); {$ENDC} 

001331 legendBox := TLegendLayoutBox(SELF.children. First); 
001332 newLegendTopLeft := legendBox. mani pulee.extentLRect.topLeft; 
001333 oldLegendTopLeft := SELF. oldLegendTopLeft; 

001334 1F NOT Equal LPt(oldLegendTopLeft, newlLegendTopLeft) THEN 
001335 BEGIN 

001336 LPt Mi nusLPt(newLegendTopLeft, oldLegendTopLeft, deltaLPt); 
001337 legendBox. OffsetLayoutBoxBy(deltaLPt, TRUE) 

001338 SELF. oldLegendTopLeft := newLegendTopLeft; 

001339 END; 
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next Box 
REPEAT 

next Box. Recal cj ust Me 

nextBox := next Box. nextSameSi zedBox: 
UNTIL 

nextBox = SELF; 


:= SELF; 


IF SELF.parent <> NIL THEN 
SELF. parent. Recal cExtent; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ Dl gLayout} 
PROCEDURE TButtonLayout Box. Recalc] ust Me 
VAR next Box: TButtonLayout Box; 


oldExtent: LRect; 
newExtent: LRect; 

PROCEDURE I nval Ol dAndNew 
BEGIN 


thePad. I nval LRect(ol dExtent); 
thePad. I nval LRect(newExtent); 
END; 
BEGIN 
{$IFC fTrace}BP(11); {$ENDC} 
ol dExtent := SELF. extentLRect; 
newExtent := SELF. mani pulee.extentLRect; 
LRectAddBorders(newExtent, SELF. borders 
SELF. Resize(newExtent); 
SELF. view. panel. OnAl | Pads Do(Inval 0! dAndNew) 
{$1FC fTrace}EP; {$ENDC} 
END; 


newExtent); 


{$$ Dil gl nit} 
END; 


METHODS OF TTitleTab; 


{$$ Sglayout} 
FUNCTION TTitleTab. CREATE( object: 
itsCaption: $255): TTitleTab; 
VAR extentLRect: LRect; 
legend: TLegend; 
location: LPoint; 
{$1FC libraryVersion <= 20} {* ** PEPSI * * *} 


TObj ect; heap: THeap; 
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itsLayout Box: 


{my manipulee's size may've changed} 


TLayout Box; itsHeight: INTEGER 
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fl nfo: TFI nfo; 
{** SPRI 


Font nfo; 


{$ELSEC} NG 


AF 
fl nfo: 
{$ENDC} 
wi dth: 


newLegTopLeft: 


| NTEGER; 
LPoint; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
WITH itsLayoutBox.extentLRect DO 
{$H- } SetLRect(extentLRect, left, top, 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TTitleTab(Tl mage. CREATE(object, heap, extentLRect, 


SELF.| ayoutBox := itsLayout Box; 


right, top + itsHei ght); 


{$H+} 


itsLayout Box. view)); 


IF itsCaption <> '' THEN {need to create a TLegend object for it} 


BEGIN 
legend := TLegend. CREATE(NIL, SELF.Heap, itsCaption, 
WITH itsLayoutBox.extentLRect DO 


{$H- } SetLPt(newLegTopLeft, (right + left - 
top + (SELF.view.res.v DIV 30)) 
{$H+} legend. Of fsetTo(newLegTopLeft); 
SELF.legend := legend 
WITH legend. extentLRect DO 
IF right - left > SELF.extentLRect.right - 
SELF. shoul dDrawLegend := FALSE 
ELSE 
SELF. shoul dDrawLegend := TRUE; 
END 
ELSE 
BEGIN 
SELF.legend := NIL; 
SELF.shouldDrawLegend := FALSE; 
END; 


{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SglLayout} 
PROCEDURE TTitleTab. Free 
BEGIN 
{$I FC fTrace}BP(11); {$ENDC} 
Free(SELF.|egend); 
SUPERSELF. Free; 
{$IFC fTrace}EP; {$ENDC} 
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SELF.view, zeroLPt, titleTypeStyle) 


legend. extentLRect.right) DIV 2, 


SELF. extentLRect. left THEN 


458 of 1012 


001436 
001437 
001438 
001439 
001440 
001441 
001442 
001443 
001444 
001445 
001446 
001447 
001448 
001449 
001450 
001451 
001452 
001453 
001454 
001455 
001456 
001457 
001458 
001459 
001460 
001461 
001462 
001463 
001464 
001465 
001466 
001467 
001468 
001469 
001470 
001471 
001472 
001473 
001474 
001475 
001476 
001477 
001478 
001479 
001480 
001481 
001482 
001483 


{$8 


{$8 


{$8 


{$8 


Apple Lisa Computer Technical Information 


END; 


{$1 FC fDebugMet hods} 

DI gDbg} 

PROCEDURE TTitleTab. Fields( PROCEDURE Field(nameAndType: $255)); 

BEGIN 
SUPERSELF. Fields( Field); 
Field('layoutBox: TLayoutBox'); 
Field('legend: TLegend' ) 
Field('shouldDrawLegend: BOOLEAN' ); 
Field(''); 

END; 

{$8 SgLayout} 

{$ENDC} 


SgLayout } 
PROCEDURE TTitl eTab. Draw 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
PenNor mal 
Fill LRect(SELF.extentLRect, | PatWhite); 
FrameLRect(SELF.extentLRect); 
|F SELF.shouldDrawLegend THEN {it exists and is small enough to fit} 
SELF. | egend. Draw 
{$I1FC fTrace}EP; {$ENDC} 
END: 


SgLayout } 
PROCEDURE TTitleTab. OffsetBy(deltaLPt: LPoint); 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
IF SELF.legend <> NIL THEN 
SELF. | egend. Offset By(deltaLPt); 
SUPERSELF. Offset By(deltaLPt); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgLayout } 
PROCEDURE TTitl eTab. Resize{(newExtent: LRect) }: 
VAR myCaption: $255; 


{$1FC libraryVersion <= 20} {* ** PEPSI * * *} 


fl nfo: TFI nfo; 


{$ELSEC} {** SPRING * *} 


fl nfo: FontI nfo; 
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{$ENDC} 
strLocation: LPoint; 
capti onWi dth: INTEGER; 
deltaLPt: LPoint 
typeStyle: TTypeStyle; 
BEGIN 


{$1FC fTrace}BP(11);{$ENDC} {this does the wrong thing for high view resolutions; must fix} 
IF SELF.legend <> NIL THEN 
BEGIN 
SELF. legend. Get String(myCapti on); 
SELF.legend. paragraph. StyleAt(0, typeStyle); 
Set QDTypeStyle(typeStyle); 
Get FontI nfo(finfo); 
captionWdth := StringWidth( myCapti on) 
{$H- } WITH newExtentLRect, flnfo DO 
SetLPt(strLocation, ((left + right - captionWidth) DIV 2) 
bottom - descent); {had had a -2 here} 
{$H+} 
SetLPt(deltaLPt, strLocation.h - SELF.|egend.! ocation.h, 
strLocation.v - SELF.legend.!ocation.v); 
SELF.legend. OffsetBy(deltaLPt); {do more cleverly -- maybe TLegend. OffsetTo} 
WITH SELF. legend. extentLRect DO 
IF right - left > newExtent.right - newExtent.left THEN 
SELF. shouldDrawLegend := FALSE 
ELSE 
SELF.shouldDrawLegend := TRUE; 
END; 
SELF.extentLRect := newExtentLRect; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Di gl nit} 
E < 


METHODS OF TLayPickSel ection; 


{$$ Sglayout} 
FUNCTION TLayPickSelection, CREATE( object: TObject; heap: THeap; itsView: TPlannerView; itsKind: 
itsLayoutBox: TLayoutBox; itsAnchorLPt: LPoint): TLayPickSel ection; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TLayPickSelection(TSelection. CREATE(object, heap, itsView, itsKind, itsAnchorLPt)); 
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SELF. | ayout Box := itsLayoutBox; 
SELF. boundLRect := itsLayoutBox.extentLRect; 
itsView.currentLayoutBox := itsLayout Box; 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$1 FC fDebugMet hods} 
DI gDbg} 
PROCEDURE TLayPickSel ection. Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
SUPERSELF. Fields( Field); 
Field('layoutBox: TLayoutBox'); 


Field(''); 
END; 
{$S SgLayout} 
{$ENDC} 
SgLayout } 


FUNCTION TLayPickSelection. CanDoCommand(cmdNumber: TCmdNumber; VAR checkit: BOOLEAN) 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
CASE cmdNumber OF 
uClear: 
CanDoCommand : = TRUE; 
OTHERW SE 
CanDoCommand : = SUPERSELF.CanDoCommand(cmdNumber, checklt); 


END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgLayout } 

PROCEDURE TLayPickSel ection. Deselect 

BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
TPlannerView( SELF. view). currentLayoutBox := NIL; 
SELF. | ayout Box. ChangeDragState( FALSE); 
SUPERSELF. Desel ect; 
{$I1FC fTrace}EP; {$ENDC} 

END; 


SgLayout } 
PROCEDURE TLayPickSelection. Highlight(highTransit: THighTransit); 
BEGIN 

{$I FC fTrace}BP(11); {$ENDC} 


BOOLEAN; 
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SELF. | ayout Box. Hi ghlight(highTransit); 
{$IFC fTrace}EP; {$ENDC} 


END; 
SgLayout } 
PROCEDURE TLayPickSel ection. MouseMove( mouseLPt: LPoint); 
VAR dif fLPt: LPoint 
diffLRect: LRect; 
BEGIN 


{$1 FC fTrace}BP( 11); {$ENDC} 
{How far did mouse move? } 
LPtMi nusLPt(mouseLPt, SELF.currLPt, diffLPt) 
{Don't move past view boundaries} 


LRect Mi nusLRect(SELF.view.extentLRect, SELF.layoutBox.extentLRect, diffLRect); 


LRectHaveLPt(diffLRect, diffLPt); 


{Move it if delta is nonzero} 
1F NOT EqualLPt(diffLPt, zeroLPt) THEN 
BEGIN 


{$H-} OffsetLRect(SELF.boundLRect, diffLPt.h, diffLPt.v); {$H+} 


LPtPlusLPt(SELF.currLPt, diffLPt, mouseLPt) 
SELF.currLPt := mouseLPt 


SELF. | ayout Box. Move( diffLPt); 


END; 
{$I1FC fTrace}EP; {$ENDC} 


END; 
SgLayout } 
PROCEDURE TLayPickSel ection. MouseRel ease 
VAR deltaLPt: LPoint; 
noSel ection: TSelection; 
mani pul ee: Tl mage; 
parent: TDi al ogl mage 
BEGIN 


{$I FC fTrace}BP( 11); {$ENDC} 

1F NOT Equal LPt(SELF.currLPt, SELF.anchorLPt) THEN 
BEGIN 
LPtMi nusLPt(SELF.currLPt, SELF. anchorLPt, deltaLPt); 


SELF. window. PerformCommand( TLayMoveCmd. CREATE(NIL, SELF. Heap, 


SELF.layoutBox, deltaLPt.h, deltaLPt.v)) 
END; 


mani pulee := SELF.| ayout Box. mani pul ee 
IF mani pulee <> NIL THEN 


manipulee.RecalcExtent; {will send it up the line to its parents} 
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001628 

001629 parent := SELF.!|ayout Box. parent; 

001630 IF parent <> NIL THEN {now send it up the line to my own parents} 
001631 IF InClass(parent, TLayoutBox) THEN 

001632 parent. RecalcExtent; 

001633 

001634 |F NOT TPlannerView(SELF.!ayout Box. view). retainPickedBox THEN 
001635 SELF. Deselect; 

001636 {$1FC fTrace}EP; {$ENDC} 

001637 END; 

001638 

001639 

001640 {$8 Sglayout} 

001641 PROCEDURE TLayPickSel ection. Restore 

001642 BEGIN 

001643 {$1FC fTrace}BP(11); {$ENDC} 

001644 TPlannerView( SELF. view). currentLayoutBox := SELF. layout Box; 

001645 SUPERSELF. Restore; 

001646 {$I1FC fTrace}EP; {$ENDC} 

001647 END; 

001648 

001649 

001650 {$8 Diglnit} 

001651 END; 

001652 

001653 

001654 METHODS OF TLayMoveCmd; 

001655 

001656 {$8 Sglayout} 

001657 FUNCTION TLayMoveCmd. CREATE{(object: TObject; heap: THeap; itsLayoutBox: TLayout Box; 
001658 itsHOffset, itsVOffset: LONGINT): TLayMoveCmd}; 
001659 VAR retainPickedBox: BOOLEAN 

001660 cmdPhase: TCmd Phase 

001661 BEGIN 

001662 {$1FC fTrace}BP( 10); {$ENDC} 

001663 IF object = NIL THEN 

001664 object := NewObject(heap, THISCLASS) 

001665 SELF := TLayMoveCmd(TCommand. CREATE(object, heap, uMoveLayoutBoxes, itsLayout Box. view 
001666 TRUE, reveal Some) ) 

001667 

001668 WITH SELF DO 

001669 BEGIN 

001670 layoutBox := itsLayoutbox; 

001671 hOffset := itsHOffset:; 

001672 vOffset := itsVOffset; 

001673 retainPickedBox := TPlannerView(itsLayout Box. view).retainPickedBox; 
001674 WITH SELF DO 

001675 BEGIN 
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unHiliteBefore[doPhase] := FALSE; 
hiliteAfter[doPhase] := FALSE; 
END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$$ Dl gDbg} 

PROCEDURE TLayMoveCmd. Fields( PROCEDURE Field(nameAndType: $255) ) 

BEGIN 
SUPERSELF. Fields( Field); 
Field('layoutBox: TLayoutBox'); 
Field('hOffset: LONGI NT') 
Field('vOffset: LONGINT') 
Field(''); 

END; 

{$ENDC} 


{$$ SglLayout} 
PROCEDURE TLayMoveCmd. Perform(cmdPhase: TCmdPhase) 


VAR planner Vi ew: TPl anner Vi ew 
panel: TPanel; 
diffLPt: LPoint; 
BEGIN 


{$I1FC fTrace}BP(12); {$ENDC} 
1F cmdPhase <> doPhase THEN 
BEGIN 
WITH SELF DO {$H- } 
CASE cmdPhase OF 


redoPhase: 

SetLPt(diffLPt, hOffset, vOffset); 
undoPhase: 

SetLPt(diffLPt, -hOffset, -vOffset); 
END; {$H+} 


SELF. | ayout Box. Move( diffLPt); 

SELF. | ayout Box. mani pulee. Recal cExtent; 

SELF. | ayout Box. Recal cExtent; 

1F NOT TPlannerVi ew(SELF.| ayout Box. view). retainPickedBox THEN 
SELF.| ayout Box. view. panel. selection. Deselect; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Di gl nit} 
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END; 


METHODS OF TEditLegendSel ection; 


{$$ Sglayout} 


FUNCTION TEditLegendSelection. CREATE(object: TObject; heap: THeap; itsLegendLayout Box: 


TLegendLayoutBox; itsAnchorLPt: LPoint): TEditLegendSel ection; 


VAR coSel ection: TSel ection; 
paragraph: TParagraph; 
paral mage: TParal mage; 
hostLegend: TLegend 
textDi al ogl mage: TText Di al ogl mage 
textl mage: TTextl mage; 
textExtent: LRect; 
typeStyle: TTypeStyle; 
hostParagraph: TParagraph; 


PROCEDURE FindBiggestFont(VAR biggestTypeStyle: TTypeStyle); 
VAR styl eChange: TStyl eChange 
{$1FC libraryVersion <= 20} {* ** PEPSI * * *} 


fl nfo: TFlI nfo: 
{$ELSEC} {** SPRING * *¥} 
fl nfo: FontI nfo; 
{$ENDC} 
i: | NTEGER; 
oldTallest: INTEGER 
BEGIN 
oldTallest := 0; 
FOR i := 1 TO hostParagraph.typeStyles.size - 1 DO 
BEGIN 
hostParagraph.typeStyles. GetAt(i, @styl eChange) ; 
host Paragraph. SetTypeStyl e(styl eChange. newSt yl e); 
Get FontI nfo(finfo); 
WITH filnfo DO 
IF oldTallest < ascent + descent + leading THEN 
BEGIN 
oldTallest := ascent + descent + leading 
biggestTypeStyle := styleChange. newStyle; 
END; 
END; 
END; 
BEGIN 


{$I FC fTrace}BP( 11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
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SELF := TEditLegendSelection(TSelection. CREATE( object, heap, itsLegendLayout Box. view 
layEditLegendSelectionKind, itsAnchorLPt)); 


IF itsLegendLayout Box. parent <> NIL THEN 


SELF. boundLRect := itsLegendLayoutBox. parent. extentLRect 
ELSE 

SELF. boundLRect := itsLegendLayoutBox. extentLRect; 
SELF.legendLayoutBox := itsLegendLayout Box; 


hostLegend := TLegend(itsLegendLayout Box. mani pul ee); 
SELF. hostLegend := hostLegend 
hostParagraph := hostLegend. paragraph; 


SELF.suppressHost := itsLegendLayout Box. suppress Drawi ngMani pul ee 


coSelection := SELF.panel.view. NoSelection; {put non-NIL coSelection} 
SELF.coSelection := coSelection; 


hostLegend. paragraph, StyleAt(0, typeStyle); {use paragraph's default if none else} 


Fi ndBi ggestFont(typeStyle); 


SetParaExtent(hostLegend. paragraph, SELF.view, hostLegend.|ocation, textExtent); 

textExtent. right := textExtent.lJeft + 10 * SELF.view.res.h; {ten inches wide} 

text Dialogl mage := TTextDialogl mage. CREATE(NIL, heap, textExtent, nolD, SELF. view 
typeStyle, ‘''); {start off with an empty guy} 

SELF. text Dial ogl mage := textDialogl mage 

textl mage := textDialogl mage. text! mage 

paral mage := TParal mage(textl mage. i mageList. First); 

paragraph := paral mage. paragraph; 


paragraph. Repl Para(0, 
paragraph.size, hostLegend. paragraph, 0, hostLegend. paragraph. size); 


paral mage. changed := TRUE; 
paral mage. I nvalLinesWith(0, MAXINT); 


textl mage. Recomputel mages(actionNone, TRUE); 


itsLegendLayout Box. textDialogl mage := textDialogl mage 
SELF.textDialogl mage := textDialogl mage 
{$IFC fTrace}EP; {$ENDC} 

END; 


{$$ Sglayout} 
FUNCTION TEditLegendSelection.Clone(heap: THeap): TObj ect; 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
SELF. text Di al ogl mage. ChangeRef Count By(1); 
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Clone := TEditLegendSel ection( SUPERSELF. Cl one( heap) ); 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgLayout } 
PROCEDURE TEditLegendSel ection. Deselect; 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
SELF. | egendLayout Box. textDialogl mage := NIL; {+SW+} 
SUPERSELF. Desel ect; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgLayout } 
PROCEDURE TEditLegendSel ection. Free 
VAR text Dial ogl mage: TText Di al ogl mage 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
textDialogl mage := SELF.textDialogl mage; {+SW+} {five lines out} 
SUPERSELF. Free: 
text Di alogl mage. ChangeRef Count By(- 1) 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 

{$S Dl gDbg} 

PROCEDURE TEditLegendSelection. Fields( PROCEDURE Field(nameAndType: $255)) 

BEGIN 
SUPERSELF. Fields(Field); 
Field('legendLayout Box: TLegendLayoutBox'); 
Field('hostLegend: TLegend' ) 
Field('textDialogl mage: TTextDi al ogl mage' ) 
Field('suppressHost: BOOLEAN' ) 
Field('tripleClick: BOOLEAN’); {+SW+} 
Field(''); 

END; 

{$ENDC} 


SgLayout } 
FUNCTION TEditLegendSel ection. CanDoCommand(cmdNumber: TCmdNumber; VAR checklt: BOOLEAN): BOOLEAN 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
CASE cmdNumber OF 
uModern, uClassic,u20Pitch, ul5Pitch, ul2Pitch, ulOPitch, ul2Point, ul4Point, ul8Point, u24Point, 
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001868 uPlain, uBold, ultalic, uUnderline, uShadow, uOutline 

001869 |F SELF. hostLegend. usesSysFont THEN 

001870 CanDoCommand := FALSE 

001871 ELSE 

001872 CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkit); 
001873 

001874 OTHERW SE 

001875 CanDoCommand := SUPERSELF. CanDoCommand(cmdNumber, checklt); 

001876 END; 

001877 {$I1FC fTrace}EP; {$ENDC} 

001878 END; 

001879 

001880 

001881 {$8 Sglayout} 

001882 PROCEDURE TEditLegendSel ection. KeyBack(f Word: BOOLEAN); 

001883 BEGIN 

001884 {$I1FC fTrace}BP(11); {$ENDC} 

001885 SELF. coSel ection. KeyBack(f Word); 

001886 SELF.legendLayoutBox.RecalcExtent; {will determine current width of the textDialogl mage and 
001887 adjust layout box + parents accordingly} 
001888 {$I FC fTrace}EP; {$ENDC} 

001889 END; 

001890 

001891 

001892 {$8 Sglayout} 

001893 PROCEDURE TEditLegendSel ection. KeyChar(ch: CHAR); 

001894 VAR newExtent: LRect 

001895 wi dth: INTEGER 

001896 paragraph: TParagraph; 

001897 i: | NTEGER; 

001898 BEGIN 

001899 {$I1FC fTrace}BP(11); {$ENDC} 

001900 paragraph := TParal mage(SELF.textDialogl mage. textl mage. i mageList. First). paragraph; 
001901 |F (paragraph.size < 255) OR 

001902 (NOT InClass(SELF.coSelection, TinsertionPoint)) THEN {can accept more} 
001903 BEGIN 

001904 SELF. coSelection. KeyChar(ch); 

001905 

001906 SELF.legendLayoutBox.RecalcExtent; {will determine current width of the textDialogl mage and 
001907 adjust layout box + parents accordingly} 
001908 END 

001909 ELSE 

001910 BEGIN 

001911 process. ArgAlert(1, '255') 

001912 process. Stop(phTooManyChars); 

001913 END; 

001914 

001915 {$I1FC fTrace}EP; {$ENDC} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 468 of 1012 


Apple Lisa Computer Technical Information 


001916 END; 

001917 

001918 

001919 {$8 SgLayout} 

001920 PROCEDURE TEditLegendSelection.KeyEnter(dh, dv: INTEGER); 
001921 BEGIN 

001922 {$1FC fTrace}BP(11); {$ENDC} 

001923 IF (dh <> 0) OR (dv <> 0) THEN 

001924 SELF. KeyTab((dh < 0) OR (dv < 0)); {right and down keys are Forward} 
001925 {$I1FC fTrace}EP; {$ENDC} 

001926 END; 

001927 

001928 

001929 {$8 SgLayout} 

001930 PROCEDURE TEditLegendSel ection. KeyReturn; 

001931 VAR selection: TSelection; 

001932 BEGIN 

001933 {$I1FC fTrace}BP(11); {$ENDC} 

001934 SELF. Deselect; 

001935 {$1FC fTrace}EP; {$ENDC} 

001936 END; 

001937 

001938 

001939 {$8 SgLayout} 

001940 PROCEDURE TEditLegendSelection. MousePress(mouseLPT: LPoint); {+SW+} 
001941 VAR selection: TSelection; 

001942 textl mage: TTextl mage 

001943 BEGIN 

001944 {$I FC fTrace}BP(11); {$ENDC} 

001945 IF clickState.clickCount < 3 THEN 

001946 SUPERSELF. MousePress( mouseLPt ) 

001947 ELSE {triple click; force SelectAll } 

001948 BEGIN 

001949 SELF.tripleClick := TRUE; 

001950 textl mage := SELF.textDialogl mage.textl mage 
001951 SELF. Hi ghlight(hOnToOff); 

001952 SELF. coSel ection, Become( 

001953 textl mage.text. SelectAll (text! mage) ) 
001954 SELF. Hi ghl i ght ( hOf f ToOn) 

001955 END; 

001956 {$I1FC fTrace}EP; {$ENDC} 

001957 END; 

001958 

001959 

001960 {$8 Sglayout} 

001961 PROCEDURE TEditLegendSelection. MouseMove( mouseLPT: LPoint); {+SW+} 
001962 BEGIN 

001963 {$I1FC fTrace}BP(11); {$ENDC} 
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001964 1F NOT SELF.tripleClick THEN 

001965 SUPERSELF. MouseMove( mouseLPt) 

001966 {$I1FC fTrace}EP; {$ENDC} 

001967 END; 

001968 

001969 

001970 {$8 SgLayout} 

001971 PROCEDURE TEditLegendSelection. MouseRelease; {+SW+} 

001972 BEGIN 

001973 {$1FC fTrace}BP(11); {$ENDC} 

001974 IF SELF.tripleClick THEN 

001975 SELF.tripleClick := FALSE 

001976 ELSE 

001977 SUPERSELF. MouseRel ease 

001978 {$I1FC fTrace}EP; {$ENDC} 

001979 END; 

001980 

001981 

001982 {$8 SgLayout} 

001983 PROCEDURE TEditLegendSel ection. PerformCommand(command: TCommand; cmdPhase: TCmdPhase) 
001984 VAR paragraph: TParagraph; 

001985 BEGIN 

001986 {$I1FC fTrace}BP(11); {$ENDC} 

001987 SUPERSELF. PerformCommand( command, cmdPhase) 

001988 IF SELF. hostLegend. usesSysFont THEN 

001989 BEGIN 

001990 paragraph := TParal mage(SELF.textDialogl mage. text! mage. i mageList. First). paragraph; 
001991 paragraph. NewStyle(0, paragraph. Size, sysTypeStyle); 
001992 END; 

001993 SELF.legendLayoutBox.RecalcExtent; {will determine current width of the textDialogl mage and 
001994 adjust layout box + parents accordingly} 
001995 {$I1FC fTrace}EP; {$ENDC} 

001996 END; 

001997 

001998 

001999 {$8 SgLayout} 

002000 PROCEDURE TEditLegendSel ection. Restore 

002001 BEGIN 

002002 {$I FC fTrace}BP(11); {$ENDC} 

002003 SELF. | egendLayout Box. textDialogl mage := SELF.textDial ogl mage 
002004 SUPERSELF. Restore; 

002005 {$I1FC fTrace}EP; {$ENDC} 

002006 END; 

002007 

002008 

002009 {$8 SgLayout} 

002010 PROCEDURE TEditLegendSel ection. Reveal (asMuchAsPossi ble: BOOLEAN) 
002011 TYPE TXLRect = PACKED ARRAY [1..SI1ZEOF(LRect)] OF CHAR 
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002012 VAR Ir: LRect; 

002013 hMi n: INTEGER; 

002014 vMi n: INTEGER; 

002015 BEGIN 

002016 {$I1FC fTrace}BP(7); {$ENDC} 

002017 SELF. coselection. boundLRect := SELF. boundLRect; 

002018 SUPERSELF. Reveal (asMuchAsPossi ble) 

002019 {$I1FC fTrace}EP; {$ENDC} 

002020 END; 

002021 

002022 

002023 {$8 Di gl nit} 

002024 END; 

002025 

002026 

002027 METHODS OF TDi al ogDesi gnWi ndow 

002028 

002029 

002030 {$S DI gAlloc} 

002031 FUNCTION TDial ogDesi gnWindow. CREATE(object: TObject; heap: THeap; 
002032 itsHostDialogView: TDialogView): TDial ogDesi gnW ndow 
002033 VAR fromBox: BOOLEAN 

002034 wi ndow: TWi ndow 

002035 ht LPt: LPoint; 

002036 hei ght: INTEGER; 

002037 ht Pt: Point; 

002038 BEGIN 

002039 {$1FC fTrace}BP(11); {$ENDC} 

002040 window := itsHostDi al ogView. panel. window 

002041 fromBox := InClass(window, TDialogBox); 

002042 1F fromBox THEN 

002043 height := window. outerRect.bottom~- window. outerRect.top + 15 
002044 ELSE 

002045 BEGIN 

002046 WITH itsHostDialogView.extentLRect DO 

002047 {$H- } SetLPt(htLPt, 0, bottom- top); {$H+} 

002048 itsHostDialogView.screenPad. LPtToPt(htLPt, htPt) 

002049 height := MIN(htPt.v + 15, screenBits. bounds. bottom ~- 30); 
002050 END; 

002051 

002052 IF object = NIL THEN 

002053 object := NewObject(heap, THISCLASS) 

002054 SELF := TDial ogDesi gnWi ndow( TDi al ogWi ndow. CREATE(object, heap, TRUE, height 
002055 diAccept, diAccept, diRefuse)); 
002056 

002057 WITH SELF DO 

002058 BEGIN 

002059 host Window := window 
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002096 
002097 
002098 
002099 
002100 
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002104 
002105 
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hostDialogView := itsHostDial ogVi ew 
fromDi al ogBox := fromBox; 


END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 

{$5 DI gDbg} 

PROCEDURE TDi al ogDesi gnWi ndow. Fields( PROCEDURE Field(nameAndType: $255)) 

BEGIN 
SUPERSELF. Fields(Field); 
Field('hostWindow: TWindow' ) 
Field('hostDialogView: TDialogView' ) 
Field('fromDi al ogBox: BOOLEAN’ ) 
Field(''); 

END; 

{$ENDC} 


{$$ Dl gLayout} 


FUNCTION TDi al ogDesi gnWi ndow. CanDoCommand(cmdNumber: TCmdNumber; VAR checkit: BOOLEAN): 


BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
CASE cmdNumber OF 
uEdit Dial og: 
CanDoCommand := FALSE; {override SUPERSELF} 
uSt opEdit Di al og: 
CanDoCommand := TRUE; 
OTHERW SE 
CanDoCommand : = SUPERSELF.CanDoCommand(cmdNumber, checklt); 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Dl gLayout} 
FUNCTION TDialogDesi gnW ndow. NewCommand(cmdNumber: TCmdNumber): TCommand 
BEGIN 
{$1FC fTrace}BP( 12); {$ENDC} 
CASE cmdNumber OF 
uSt opEditDi al og: 
BEGIN 
SELF. Rel i nquishControl 
NewCommand := NIL; 
END; 
OTHERW SE 
NewCommand := SUPERSELF. NewCommand( cmdNumber ) 
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END; 


{$I1FC fTrace}EP; {$ENDC} 


{$$ Dl gLayout} 
PROCEDURE TDi al ogDesi gnWi ndow. Reli nquishControl 


{not yet: install in resourceFile} 
VAR panel: TPanel; 
pl anner Vi ew: TPl annerVi ew 
di al ogWi ndow: TDi al ogWi ndow 
newHei ght: INTEGER 
noSel ection: TSel ection; 
newBot Ri ght: point; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
panel := SELF.sel ect Panel 
panel.selection. Desel ect; {should incorporate last text edit, if any} 
panel. window. Commi tLast; 
panel. Begi nSel ecti on; {previous didn't really quite do it yet} 
current Window. TakeDownDi al ogBox; {take down layout dialog} 
[F SELF.fromDialogBox THEN {editing a dialog box--copy the resizing back to the dialog Window} 
BEGIN 
plannerView := TPlannerView(panel.currentVi ew) 
newHei ght := panel.innerRect. bottom 
di alogWi ndow := TDi al ogWi ndow( pl anner Vi ew. vi ewBei ngPl anned. panel. wi ndow) ; 
Set Pt(newBotRight, screenBits. bounds. right, newHei ght); {transfer its current...} 
current Window, Put UpDi al ogBox( di al ogWi ndow) ; 
di al ogWi ndow. Resi zeTo( newBotRi ght); {height to main dialog} 


IF dialogWndow.selectPanel.selection. kind <> nothingKind THEN 
current Window. selectWindow := dialogWndow; {=} 
END; 


SELF.selectPanel. view := NIL; {kludge to avoid clobbering the main view} 
current Window. Focus; {necessary to avoid a later popFocus trying to focus our now departed 


Di al ogDesi gnWi ndow} 


SELF. Free; {!} 


END; 


{$I1FC fTrace}EP; {$ENDC} 


{$$ Dl gLayout} 
PROCEDURE TDi al ogDesi gnW ndow. Resi ze( moving: BOOLEAN); 
VAR view: TView 


BEGIN 


extentLRect: LRect; 
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{$1FC fTrace}BP(11); {$ENDC} 
SUPERSELF. Resize( moving); {moving is always FALSE of course} 
IF SELF. host Window.isResizable THEN 
{do nothing, | guess} 
ELSE 
BEGIN 
view := SELF.selectPanel. current View 
extentLRect := view. extentLRect; 
extentLRect,. bottom := SELF.selectPanel.innerRect. bottom 
view. Resi ze(extentLRect); {that'll be the layout view} 
SELF. host Di al ogVi ew. Resi ze(extentLRect); 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END: 


{$$ Dl gLayout} 
PROCEDURE TDi al ogDesi gnWi ndow. Sei zeControl; 


VAR dialogVi ew: TDi al ogVi ew 
panel: TPanel; 
children: TList; 
imageList: TList; 

di al ogBox: TDi al ogBox; 


savedSetting: BOOLEAN 
BEGIN 

{$1FC fTrace}BP(11); {$ENDC} 

dialogView := SELF. host Di al ogVi ew 

children := dialogView. root Dialog. children; 

[F SELF.fromDialogBox THEN 
BEGIN 
di alogBox := current Window. di al ogBox; 
savedSetting := dial ogBox.freeOnDismissal 
di alogBox.freeOnDismissal := FALSE; 
current Window. TakeDownDi al ogBox; 
di alogBox.freeOnDismissal := savedSetting 
END; 


panel := TPanel.CREATE(NIL, SELF.Heap, SELF, 0, SELF.innerRect.right - 


[aScroll, aBar]); 
SELF.control Panel := panel 


CASE children. Size OF 
0 


23, [aScroll, aBar] 


ABCBreak('SeizeControl, empty children of dialog view, 0); 


1: imageList := TDialog(children. First). children; 
OTHERW SE imageList := children; 
END; {case} 
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002204 TPlannerView. CREATE(NIL, SELF. Heap, dialogView, panel, FALSE, FALSE). I nit(imageList) 
002205 

002206 current Window. Put UpDi al ogBox( SELF) 

002207 panel. Begi nSel ecti on; 

002208 {$I1FC fTrace}EP; {$ENDC} 

002209 END: 

002210 

002211 


002212 {$$ Diginit} 
002213 END; 
002214 


End of File -- Lines: 2214 Characters: 68581 
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{UDi al og4} {Handles Page Headings & Page Margins} {Copyright 1984 by Apple Computer, I NC} 
(* 
ORDER OF METHODS: 


CLASS SUBCLASS OF WHICH IS IN 
TStdPrint Manager TPrint Manager UABC3 
TLegendHeadi ng THeadi ng UABC3 
TPageDesi gnWi ndow TDi al ogWi ndow UDi al og2 
TPagePl annerVi ew TPlanner Vi ew UDi al 0g3 
TPageLayout Box TLayout Box UDi al og3 
TLgHdngLayout Box TPageLayoutBox  UDialog4 
TPageStatusDi al og TDial og UDi al og2 


*) 
{04/25/84 19:00 TLgHdngLayout Box. MousePress -- don't invalidate the layout box 
TPageStatusDialog. CREATE explicitly sets extentLRect's topLeft to zeroLPt} 
{04/24/84 23:51 TPageDesignWindow. CREATE sets the status view's scroll PastEnd to zeroPt} 
{04/24/84 18:00 TPageDesignWindow. CREATE allows scrolling in the status panel } 
{04/23/84 12:18 In TStdPrintManager. SetDfltHeadings, supply a blank space before and after the 
the '{TITLE)', so that a select-all followed by a font change will result in 
the new font applying to the substituted string at print or page-preview ti me} 
{04/17/84 17:16 Make the TPagePlannerView show no gray at the end. } 
{04/15/84 0200  TPageDesignWindow. NewCommand frees panel's undoSelection as well as main selection} 
{04/14/84 03:00 Removed pilotHeading from TPageLayoutBox; removed TPageLayoutBox. Free, consequently, 
as well as TPageLayoutBox. Fields 
Offset master as well as current Legend in TLegendHeadi ng. Offset By} 
{changed 04/14/84 0102 Major rewrite of TLgHdngLayout Box. RecalcExtent & TP } 
{changed 04/13/84 2230 TLgHdngLayoutBox.RecalcExtent doesn't call SetParaExtent; just uses legend's extent 
& TPageLayout Box. FreeManipulee sets SELF. manipulee to NIL after freeing 
& TPageDesi gnWi ndow. NewCommand sets plannerView. currentLayoutBox to NIL 
after freeing the LgHdngLayout Box... } 
{changed 04/13/84 1630 Changed to not using bolding on the margins-dialog heading} 
{changed 04/11/84 2315 Do TopToBaseLine stuff in hdngs recalculation only if not fExperimenting...} 
{changed 04/11/84 1700 Use dfltNewHeading global var in laucnhing new heading in TDi al ogDesi gnWi ndow. NewCmd, 
and varPage and varTitle in TStdPrint Manager. Set Dfl tHeadi ngs 
In TPageStatusDialog. CREATE, use a CONST depending on libraryVersion to determine 
the spacing between the boxes in the margins checkbox dialog} 
{04/04/84 2300 Spring Prelim Rel ease} 
{01/29/84 1800 RELEASE TK8D} 
{12/21/83 1657 RELEASE TK8A} 
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METHODS OF TStdPrint Manager; 


{$8 


{$8 


{$8 


{$8 


DI gAl | oc} 
FUNCTION TStdPrintManager. CREATE(object: TObject; heap: THeap): TStdPrint Manager 
BEGIN 

{$1FC fTrace}BP(11); {$ENDC} 

IF object = NIL THEN 

object := NewObject(heap, THISCLASS) 

SELF := TStdPrintManager(TPrintManager. CREATE(object, heap)); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


DI gAl | oc} 
PROCEDURE TStdPrint Manager. Set DfltHeadi ngs 
CONST topFudge = 0; 
bottomFudge = 0 
VAR anOffset: LPoint; 
margins: LRect; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
margins := SELF. pageMargins 
SetLPt(anOffset, 0, (margins. top + topFudge) DIV 2); 
SELF. headings. | nsLast(TLegendHeading. CREATE(NIL, SELF.Heap, SELF, CONCAT(' {', varTitle, 
stdHdngTypeStyle, aTopCenter, anOffset, stdHdngBorders) ); 


SetLPt(anOffset, 0, - (ABS(margins. bottom + bottomFudge) DIV 2)) 
SELF. headings. I nsLast(TLegendHeading. CREATE(NIL, SELF.Heap, SELF, CONCAT('-{', varPage 
stdHdngTypeStyle, aBottomCenter, anOffset, stdHdngBorders) ) 


{$I1FC fTrace}EP; {$ENDC} 
END; 


DI gAl | oc} 
PROCEDURE TStdPrintManager.Init(itsMainView: TView; itsDfltMargins: LRect); 
BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
SUPERSELF.I nit(itsMainView, itsDflt Margins) 
SELF. canEditPages := TRUE; 
{$IFC fTrace}EP; {$ENDC} 
END; 


Hdg Mar g} 
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PROCEDURE TStdPrintManager. Enter PageEditti ng; 


VAR window: TW ndow 
pageDesi gnWi ndow: TPageDesi gnWi ndow 
pagePl anner Vi ew: TPagePl anner Vi ew 
BEGIN 


{$I1FC fTrace}BP(7); {$ENDC} 

window := SELF. view. panel. window 

wi ndow. Commi tLast; 

1F SELF. ayoutDialogBox = NIL THEN 
BEGIN 
pageDesi gnWi ndow := TPageDesi gnWi ndow. CREATE(NIL, SELF.Heap, SELF. vi ew) 
SELF. | ayout Dial ogBox := pageDesi gnWi ndow; 
END; 

window. Put UpDi al ogBox( SELF. | ayout Di al ogBox); 

{$1FC fTrace}EP; {$ENDC} 

END; 


{$$ TK2Start} 

PROCEDURE TStdPrintManager. ReactToPrinterChange 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
SUPERSELF. React ToPrinter Change; 
[F SELF.layoutDialogBox <> NIL THEN 

TPageDesi gnWi ndow( SELF. 1 ayout Di al ogBox). | ayout Panel. view, Resize( SELF. pageView. extent LRect); 

{$1FC fTrace}EP; {$ENDC} 

END; 


{$$ Di gl nit} 
E ' 


METHODS OF TLegendHeadi ng; 


{$S DI gAl loc} 
FUNCTION TLegendHeading. CREATE(object: TObject; heap: THeap; itsPrintManager: TPrintManager 
itsString: $255; itsTypeStyle: TTypeStyle 
itsPageAlignment: TPageAlignment; itsOffsetFromAlignment: LPoint; 
itsBorders: Rect): TLegendHeadi ng 
VAR newMaster: TLegend 
newCurrent: TLegend 
extent: LRect; 
view: TVi ew 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
view := itsPrint Manager. pageVi ew 
SetLRect(extent, 0, 0, 100, 100); {meaningless at this point} 
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IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TLegendHeading(THeading. CREATE(object, heap, itsPrintManager, extent, itsPageAlignment, 
itsOffsetFromAlignment) ); 


newMaster: = TLegend. CREATE(NIL, heap, itsString, view, zeroLPt, itsTypeStyle); 
newCurrent := TLegend. CREATE(NIL, heap, itsString, view, zeroLPt, itsTypeStyle) 
newMaster. HaveVi ew( view); 

newCurrent. HaveVi ew( vi ew); 


SetParaExtent(newMaster. paragraph, view, zeroLPt, extent) 


WITH SELF DO 
BEGIN 
masterLegend := newMaster 
currentLegend := newCurrent; 
borders := itsBorders; 
mi nPage := 1; {readjusts fromstd 2, for demo purposes} 
topToBaseline := - itsBorders.top - extent.top; {both tops are negative} 
END; 


newMaster. wouldBeDraggable := FALSE; 
newCurrent. wouldBeDraggable := FALSE; 


SELF. Recal cExtent; 
{$IFC fTrace}EP; {$ENDC} 


HdgMar g} 
PROCEDURE TLegendHeadi ng. Free 


BEGI 


END; 


N 

{$I1FC fTrace}BP(7); {$ENDC} 
Free(SELF. masterLegend); 
Free(SELF.currentLegend); 
SUPERSELF. Free; 

{$I1FC fTrace}EP; {$ENDC} 


{$1 FC fDebugMet hods} 


{$$ 


DI gDbg} 


PROCEDURE TLegendHeadi ng. Fiel ds( PROCEDURE Field(nameAndType: $255) ) 


BEGI 


N 

SUPERSELF. Fields( Field); 
Field('masterLegend: TLegend' ) 
Field('currentLegend: TLegend') 
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Field('topToBaseline: INTEGER') 
Field('borders: Rect'); 


Field(''); 
END; 
{$ENDC} 
{$$ Dl gRes} 
PROCEDURE TLegendHeadi ng. Adj ustForPage( pageNumber: LONGINT; editing: BOOLEAN); 
VAR currS255: $255; 
aVariable: $255; 
leftBracePos: INTEGER 
rightBracePos: INTEGER 
newVal ue: $255; 
restOfString: $255; 
newExtent: LRect; 
current Paragraph: TParagraph; 
masterParagraph: TParagraph; 
substituted: BOOLEAN 
lastPosition: INTEGER; 
BEGIN 


{$1FC fTrace}BP( 9); {$ENDC} 
substituted := FALSE; {still flawed} 
lastPosition := 0 
SELF. masterLegend. Get String(curr$255) 
current Paragraph := SELF.currentLegend. paragraph; 
masterParagraph := SELF. masterLegend. paragraph; 
current Paragraph, Repl Para(0, currentParagraph.size, masterParagraph, 0, 
masterParagraph.size); {download entire master into current} 
1F NOT editing THEN 
BEGIN 
REPEAT 
leftBracePos := POS('{', curr$255); 
IF leftBracePos > 0 THEN 
IF leftBracePos < lastPosition THEN {was within the previous variable} 
currS255[leftBracePos] := '$' {... $0 we won't get it next time} 
ELSE 
BEGIN 


restOfString := COPY(currS255, leftBracePos + 1, LENGTH(currS255) - leftBracePos); 


rightBracePos := POS('}', restOfString) 
1F rightBracePos > 0 THEN 
BEGIN 
aVariable := COPY(restOfString, 1, rightBracePos - 1); 
SELF. printManager. view. SetFunctionValue(aVariable, newValue) 
substituted := TRUE; 
current Paragraph. Repl PString(leftBracePos - 1, rightBracePos + 1, 
@newVal ue); 
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DELETE(curr$255, leftBracePos, rightBracePos + 1); {get rid of the var code} 
INSERT( newValue, currS255, leftBracePos); {substitute the variable's value} 


currS255[leftBracePos] := '$'; 
lastPosition := leftBracePos + LENGTH( newVal ue) 
END 

ELSE 


lastPosition := LENGTH(currS255) + 1: 
END; 
UNTIL 
leftBracePos = 0; 


END {not editing} 


ELSE {editing} 
SELF. mast erLegend. Get BoxRi ght; 


SELF. RecalcExtent; {tells currentLegend to get box right, then adds in my borders} 

{we only need worry about our extentLRect, our location, and our current legend al 
being in synch; THeading.LocateOnPage will then find the exact page location, 
taking into account my offsetFromAl i gnment } 


{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ Dl gRes} 

PROCEDURE TLegendHeadi ng. Draw 

BEGIN 
{$IFC fTrace}BP( 9); {$ENDC} 
1F SELF.ShouldFrame THEN 

FrameLRect(SELF.extentLRect); 

SELF. currentLegend. Draw 
{$I1FC fTrace}EP; {$ENDC} 

END: 


{$$ HdgMarg} 
FUNCTION TLegendHeading.LaunchLayoutBox(view: TView): TI mage 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
LaunchLayoutBox := TLgHdngLayoutBox. CREATE(NIL, SELF.Heap, view, SELF) 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$$ HdgMarg} 
PROCEDURE TLegendHeadi ng. OffsetBy(deltaLPt: LPoint); 
BEGIN 
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000284 {$1FC fTrace}BP(9); {$ENDC} 

000285 SELF. currentLegend. Offset By(deltaLPt) 
000286 SUPERSELF. Offset By(deltaLPt); 
000287 {$I1FC fTrace}EP; {$ENDC} 

000288 END; 

000289 

000290 

000291 {$8 TK2Start} 

000292 PROCEDURE TLegendHeadi ng. RecalcExtent; 
000293 VAR newExtent: LRect; 

000294 BEGIN 

000295 {$1FC fTrace}BP(9); {$ENDC} 

000296 SELF. currentLegend. Get BoxRi ght; 
000297 LRectAddBorders(SELF.currentLegend.extentLRect, SELF. borders, newExtent) 
000298 SELF. Resize(newExtent); 

000299 {$1FC fTrace}EP; {$ENDC} 

000300 END; 

000301 

000302 

000303 {$8 Di gRes} 

000304 FUNCTION TLegendHeadi ng. Shoul dFrame 
000305 BEGIN 

000306 {$1 FC fTrace}BP(9); {$ENDC} 

000307 ShouldFrame := FALSE; 

000308 {$I1FC fTrace}EP; {$ENDC} 

000309 END; 

000310 

000311 

000312 {$8 Diglnit} 

000313 END; 

000314 

000315 

000316 METHODS OF TPageDesi gnWi ndow 

000317 

000318 

000319 {$8 DI gAll oc} 

000320 FUNCTION TPageDesi gnWi ndow. CREATE(object: TObject; heap: THeap; itsHostView: TView): TPageDesi gnWi ndow 
000321 CONST cPgWindowHeight = 340 
000322 cPgControl Height = 130; {height of the control (status) panel } 
000323 cHtStatusView = 220 

000324 

000325 VAR control Panel: TPanel: 

000326 layout Panel: TPanel: 

000327 hdngDi al og: THeadingDialog 
000328 pl anner Vi ew: TPl anner Vi ew 
000329 di al ogVi ew: TDi al ogVi ew 
000330 extentLRect: LRect; 

000331 BEGIN 
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{$1 FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 


SELF := TPageDesi gnW ndow( TDi al ogWindow. CREATE(object, heap, TRUE, cPgWindowHeight, diAccept, 


diAccept, diRefuse)); 


SELF. hostView := itsHost View; 


layoutPanel := TPanel.CREATE(NIL, heap, SELF, 0, 0, [aScroll, aSplit], [aScroll, aSplit]); 
plannerView := TPagePl annerView. CREATE(NIL, heap, itsHostView. printManager, layout Panel); 
SELF.|ayoutPanel := layout Panel 
control Panel := layoutPanel. Divide(v, cPgControlHeight, pixelsFromEdge 

[userCanResizelt], 10 {min size}, [aScroll], [aScroll]); {+S W+} 
SELF. control Panel := control Panel 


SetLRect(extentLRect, 0, 0, screenBits. bounds.right, cHtStatusView); 


dialogView := TDialogView. CREATE(NIL, heap, extentLRect, controlPanel, NIL, screenRes) 


dialogView.scrollPastEnd := zeroPt; {+SW+} 
di al ogView. AddDi al og(TPageStatusDialog. CREATE(NIL, heap, dialogView. panel) ) 


{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
PROCEDURE TPageDesi gnWi ndow. Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
SUPERSELF. Fields( Field); 
Field('hostView: TView' ) 
Field('layoutPanel: TPanel' ) 
Field(''); 
END; 
{$ENDC} 


PROCEDURE TPageDesi gnWi ndow. Disappear 
VAR panel: TPanel 


BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
panel := TPagePl annerView(SELF.!ayout Panel. view). vi ewBei ngPl anned. panel 


IF panel. previewMode = mPrvwMargins THEN {make sure headings are updated} 
panel. I nvalidate 

SUPERSELF. Disappear 

{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ HdgMarg} 
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000380 FUNCTION TPageDesi gnWi ndow, NewCommand(cmdNumber: TCmdNumber): TCommand; 

000381 {unusually, uClear is armed by TLayPickSelection. NewCommand but dealt with by the PageDesi gnWi ndow} 
000382 VAR s: TListScanner; 

000383 layout Box: TLayout Box; 

000384 pl anner Vi ew: TPl anner Vi ew 

000385 noSel ection: TSel ection; 

000386 command: TCommand; 

000387 selectedBox: TLayout Box; 

000388 panel: TPanel: 

000389 BEGIN 

000390 {$1FC fTrace}BP(11); {$ENDC} 

000391 CASE cmdNumber OF 

000392 uClear: {not undoable at present... } 

000393 BEGIN 

000394 SELF.CommitLast; {The committal might require a to-be-freed text! mage} 
000395 plannerView := TPlannerView(SELF.! ayout Panel. view); 

000396 panel := plannerView. panel 

000397 selectedBox := plannerView. currentLayout Box; 

000398 s := plannerView. root Di al ogl mage. chil dren, Scanner 

000399 WHILE s.Scan(layoutBox) DO 

000400 IF layoutBox = selectedBox THEN 

000401 BEGIN 

000402 panel.selection. Desel ect; 

000403 noSelection := panel. undoSelection. FreedAndRepl acedBy( panel. view. NoSel ection) 
000404 panel. I nval LRect(layout Box. extentLRect); 

000405 layout Box. FreeMani pul ee; {Delete heading fromthe printManager} 
000406 s. Del et e( TRUE) ; {Delete heading's layout box fromthe planner Vi ew} 
000407 s. Done; 

000408 END; 

000409 command := TCommand. CREATE(NIL, plannerView. Heap, uClear, plannerView, FALSE, 
000410 reveal None); 

000411 NewCommand := command 

000412 planner View. currentLayoutBox := NIL; 

000413 TPageStatusDi al og(SELF. mai nDialog).currentHeading := NIL; 

000414 END; 

000415 

000416 OTHERW SE 

000417 NewCommand := SUPERSELF. NewCommand(cmdNumber ) 

000418 END; 

000419 {$I1FC fTrace}EP; {$ENDC} 

000420 END; 

000421 

000422 {$8 Di gl nit} 

000423 END; 

000424 

000425 

000426 METHODS OF TPagePl anner Vi ew 

000427 
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{$$ DI gAl loc} 
FUNCTION TPagePl annerView. CREATE( object: TObject; heap: THeap; itsPrintManager: TPrint Manager 


BEGI 


END; 


itsPanel: TPanel): TPagePl annerVi ew 
N 
{$I1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TPagePlannerView(TPlannerView. CREATE(object, heap, itsPrintManager. pageView, itsPanel 
FALSE, TRUE) ); 
PushFocus; 
TPane(itsPrintManager. view. panel. panes. First). Focus; {so that thePad will be set to something} 
SELF. I nit(itsPrint Manager. headings); 
PopFocus; 


SELF.scroll PastEnd := zeroPt; 
{$IFC fTrace}EP; {$ENDC} 


{$$ HdgMarg} 
PROCEDURE TPagePl anner View. Draw 


BEGI 


END; 


{$$ Dl gl 
EN 


METHODS 


VAR contentLRect: LRect; 
pat: Pattern; 
content Rect: Rect; 
N 
{$I1FC fTrace}BP(11); {$ENDC} 
contentLRect := SELF. viewBeingPlanned. print Manager. contentLRect; {screen embellishments} 
thePad. LPatToPat(marginPattern, pat); 
thePad. LRectToRect(contentLRect, contentRect); 
FillRect(contentRect, pat); 


PenNor mal 
FrameLRect (SELF. extentLRect); 
FrameLRect(contentLRect); 


SUPERSELF. Draw; {draw Layout Boxes} 
{$I FC fTrace}EP; {$ENDC} 


nit} 


OF TPageLayout Box; 


{$$ HdgMarg} 
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FUNCTION TPageLayout Box. CREATE(object: TObject; heap: THeap; itsView: TView; itsHeading: THeading 


itsResizable: BOOLEAN): TPageLayout Box; 
VAR baseExtent: LRect; 


BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
baseExtent := itsHeading. extentLRect; 


baseExtent.top := baseExtent.top + stdSlimTitl eHei ght; 
IF object = NIL THEN 
object := NewObject(itsHeading. Heap, THISCLASS) 

SELF := TPageLayoutBox(TLayoutBox. CREATE(object, heap, baseExtent, nolD, NIL, 
itsView, itsHeading, stdPlainBorders, itsResizable, 
TRUE, TRUE)); 

{$I1FC fTrace}EP; {$ENDC} 

END; 


{$1 FC fDebugMet hods} 
{$S Dl gDbg} 
PROCEDURE TPageLayout Box. Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
SUPERSELF. Fields( Field); 
Field(''); 
END; 
{$ENDC} 


HdgMar g} 
PROCEDURE TPageLayout Box. FreeMani pul ee 
VAR s: TListScanner; 
heading: THeadi ng; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
s := TPlannerView( SELF. view). vi ewBei ngPl anned. view. print Manager. headings. Scanner 
WHILE s.Scan(heading) DO 
1F heading = SELF. manipulee THEN 
BEGIN 
s. Del et e( TRUE) ; 
s. Done; 
SELF. mani pulee := NIL; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


HdgMar g} 
PROCEDURE TPageLayout Box. TabGrabbed 
VAR heading: THeadi ng; 
pageStatusDi al og: TPageStatusDi al og 
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000524 BEGIN 

000525 {$lFC fTrace}BP( 10); {$ENDC} 

000526 heading := THeading(SELF. mani pul ee) 

000527 pageStatusDialog := TPageStatusDi al og(TDi al ogVi ew( TDi al ogWi ndow( SELF. view. panel. wi ndow 
000528 ). control Panel. view). rootDialog. children, First); 

000529 IF heading <> pageStatusDialog.currentHeading THEN 

000530 BEGIN 

000531 WITH heading DO 

000532 {$H- } pageStatusDialog. SetHeadingParms(oddOnly, evenOnly, pageAlignment, minPage, maxPage); {$H+} 
000533 pageStatusDialog.currentHeading := heading 

000534 END; 

000535 {$IFC fTrace}EP; {$ENDC} 

000536 END; 

000537 

000538 

000539 {$S Di gl nit} 

000540 END; 

000541 

000542 

000543 METHODS OF TLgHdngLayout Box; 

000544 

000545 {$8 HdgMarg} 

000546 FUNCTION TLgHdngLayout Box. CREATE(object: TObject; heap: THeap; itsView: TView 
000547 itsLegendHeading: TLegendHeading): TLgHdngLayout Box; 

000548 VAR myExtent: LRect; 

000549 itsTitleTab: TTitleTab; 

000550 masterLegend: TLegend 

000551 legendLayout Box: TLegendLayoutBox; {= SELF. children. First} 

000552 BEGIN 

000553 {$I1FC fTrace}BP(7); {$ENDC} 

000554 itsLegendHeading. Adj ustForPage(0, TRUE) 

000555 itsLegendHeading. Locat eOnPage( TRUE) 

000556 masterLegend := itsLegendHeadi ng. masterLegend 

000557 masterLegend. location := itsLegendHeading.currentLegend. | ocation; 

000558 masterLegend. Get BoxRi ght; 

000559 

000560 LRect AddBorders(masterLegend.extentLRect, itsLegendHeading. borders, myExtent) 
000561 

000562 IF object = NIL THEN 

000563 object := NewObject(heap, THI SCLASS) 

000564 SELF := ThgHdngLayout Box(Tl mageWthID.CREATE(object, heap, myExtent, nolD, 
000565 itsView, TRUE)); 

000566 

000567 itsTitleTab := TTitleTab. CREATE(NIL, heap, SELF, stdSlimTitleHeight, nolD); 
000568 

000569 WITH SELF DO 

000570 BEGIN 

000571 titleTab := itsTitleTab; 
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manipulee := 
suppress Drawi ngMani pulee 


itsLegendHeadi ng; 
:= TRUE; 


wouldMakeSelection := TRUE; 
isResizable := FALSE: 
isDraggable := TRUE; 
shouldFrame := TRUE; 
borders := zeroRect; 

END; 


| egendLayout Box 
SELF. legendLayoutBox := legendLayout Box; 
SELF. Addl mage(l egendLayout Box) 


{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$S DI gDbg} 
PROCEDURE TLgHdngLayout Box. Fields( PROCEDURE Field(nameAndType 
BEGIN 
SUPERSELF. Fields( Field); 
Field('legendLayout Box: TLegendLayoutBox' ) 
Field(''): 
END; 
{$ENDC} 


{$$ HdgMarg} 
FUNCTION TLgHdngLayout Box. CursorAt( mouseLPt: 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
IF SELF. Hit(mouseLPt) THEN 
IF SELF. titleTab. Hit(mouseLPt) THEN 
CursorAt := arrowCursor 
ELSE 
CursorAt 


LPoint): 


:= textCursor 
ELSE 
CursorAt := noCursor 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ HdgMarg} 
PROCEDURE TLgHdngLayout Box. Draw 
BEGIN 
{$IFC fTrace}BP(11); {$ENDC} 
IF LRectIlsVisible(SELF.extentLRect) THEN 
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:= TLegendLayout Box(itsLegendHeadi ng. masterLegend. LaunchLayout Box(itsVi ew) ) 


$255) ); 


TCursorNumber: 
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BEGIN 

SELF. titleTab. Draw 

PenNor mal 

FrameLRect(SELF.extentLRect); {draw overall box} 
SELF. | egendLayout Box. Draw 


END; 
{$1FC fTrace}EP; {$ENDC} 


END; 
Hdg Mar g} 
PROCEDURE TLgHdngLayout Box. MousePress(mouseLPT: LPoint); 
VAR | ayout Box: TLayout Box; 
S! TListScanner; 
editLegendSel ection: TEditLegendSel ecti on; 
BEGI N 


END; 


{$I1FC fTrace}BP(11); {$ENDC} 
LRectHaveLPt(SELF.|egendLayoutBox.extentLRect, mouseLPt) 
editLegendSelection := TEditLegendSel ection(SELF.view. panel.sel ection. FreedAndRepl acedBy( 
TEditLegendSelection, CREATE(NIL, SELF. Heap 
SELF.| egendLayout Box, 
mouseLPT))); 
SELF. TabGrabbed; {get report on me right in the page status panel } 
editLegendSel ection. text Dial ogl mage. MousePress(mouseLPt) 
{$I1FC fTrace}EP; {$ENDC} 


Hdg Mar g} 
PROCEDURE TLgHdngLayout Box. Move(deltaLPt: LPoint); 


BEGI 


VAR legendHeading: TLegendHeadi ng 

N 

{$1FC fTrace}BP( 10); {$ENDC} 

SUPERSELF. Move(deltaLPt); {offsets and invalidates} 
legendHeading := TLegendHeadi ng( SELF. mani pul ee) 
legendHeading. masterLegend, Offset By(deltaLPt); 


{$H-} LPtPlusLPt(legendHeading. offsetFromAlignment, deltaLPt, | egendHeading. offset FromAl i gnment); 
{$I FC fTrace}EP; {$ENDC} 


END; 


{$$ HdgMarg} 
PROCEDURE TLgHdngLayout Box. Recal cExtent; 


VAR newExtent: LRect; 
ol dExtent: LRect; 
deltaLPt: LPoint; 
newBaseLPoi nt: LPoint; 
borders: Rect; 
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masterLegend: TLegend 
ol dTopToBasel ine: LONGI NT; 
newTopToBasel i ne: LONGI NT; 


| egendHeadi ng: TLegendHeadi ng; 

textExtent: LRect; 

ali gnedToTop: BOOLEAN 

ol dDescent: INTEGER 
PROCEDURE I nval Ol dAndNew 

BEGIN 


thePad. | nval LRect(ol dExtent); 
thePad. I nval LRect(newExtent); 
END; 


BEGIN 


{$1FC fTrace}BP( 3); {$ENDC} 

ol dExtent := SELF. extentLRect; 

legendHeading := TLegendHeadi ng( SELF. mani pul ee) 
masterLegend := | egendHeadi ng. masterLegend 


borders := | egendHeadi ng. borders; 
ol dTopToBaseline := | egendHeadi ng. topToBaseline 


SetParaExtent(masterLegend. paragraph, SELF. view, zeroLpt, textExtent) 


newlopToBaseline := - borders.top - textExtent. top; 


alignedToTop := legendHeading. pageAlignment IN [aTopLeft, aTopCenter, aTopRi ght] 


IF newTopToBaseline <> oldTopToBaseline THEN 
BEGIN 
IF alignedToTop THEN 


legendHeadi ng. offsetFromAlignment.v := |egendHeading. offsetFromAlignment.v + 


oldTopToBaseline - newTopToBaseline 
ELSE {bottom alignment} 


BEGIN 
WITH oldExtent DO 

oldDescent := bottom~- top - oldTopToBaseline 
legendHeadi ng. offsetFromAlignment.v := | egendHeading.offsetFromAlignment.v - 


textExtent. bottom + ol dDescent; 
END; 
legendHeadi ng. topToBaseline := newTopToBaseline 
END; 


LRect AddBorders(SELF.!egendLayoutBox.extentLRect, borders 
| egendHeadi ng. Resi ze( newExtent); 


| egendHeadi ng. Locat eOnPage( TRUE); 
newExtent := legendHeadi ng. extentLRect 


newExtent); 


SetLPt(newBaseLPoint, newExtent.left - borders. left, newExtent.top + newTopToBaseli ne); 
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masterLegend. location := 
masterLegend. Get BoxRi ght; 
SELF. Resize(newExtent); 


newBaseL Poi nt; 


LPtMi nusLPt(newExtent.topLeft, oldExtent.topLeft, deltaLPt) 
SELF. | egendLayout Box. OffsetLayout BoxBy(deltaLPt, FALSE); 


1F NOT equal LRect(oldExtent, 
SELF. vi ew. panel 


SELF. TabGrabbed 


newExtent) THEN 
OnAl | Pads Do(I nval Ol dAndNew) ; 


{update page-status-dialog report panel } 


{$1FC fTrace}EP; {$ENDC} 


END; 


{$$ Dil gl nit} 
E 1 


METHODS OF TPageStatusDi al og; 


{$$ DI gAll oc} 


FUNCTION TPageStatusDi al og. CREATE(object: TObj ect; 


CONST 
{$1FC libraryVersion <= 20} 


heap: THeap; 


spcAdjustment = -1; 
{$ELSEC} { SPRING } 
spcAdjustment = -1; 
{$ENDC} 

VAR cluster: TCluster: 
aNumberString: $255; 
input Frame: Tl nput Frame 
button: TButton: 
promptLoc: LPoi nt; 
inputLoc: LPoint 
borders: Rect; 
checkbox: TCheckbox; 
newl mage: TDi al ogl mage 
typeStyle: TTypeStyle; 
label Offset: Point; 
legend: TLegend; 
boxSpaci ng: | NTEGER; 
its!D: $255; 
itsLocation: LPoint; 

BEGIN 
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itsPanel: TPanel): TPageStatusDi al og 
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{$I1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TPageStatusDialog(TDialog. CREATE(object, heap, 'PAGE', itsPanel.view)); 


SELF. currentHeading := NIL; 
MakeTypeStyle(famModern, sizel2Pitch, [], typeStyle) 


SetPt(label Offset, 6, 0); 

cluster := SELF. NewCl uster( phOddEven) 

checkbox := cluster. NewCheckbox(phOddOnly, stdBoxWdth - 3, stdBoxHeight - 2, 
TRUE, labelOffset, typeStyle, FALSE) 

checkbox := cluster. NewAli gnedCheckbox(phEvenOnly, FALSE) 

checkbox := cluster. NewAli gnedCheckbox( phOddOrEven, TRUE) 

SELF. oddEvenCluster := cluster 


SetRect(borders, -18, -2, 18, 2); 

inputFrame := SELF. NewlnputFrame(phMinPage, typeStyle, stdFrmeOffset, stdinputTypeStyle, 
borders, FALSE, FALSE) 

LI ntToStr(2, @aNumber String); 

inputFrame. Suppl ant Contents(aNumber String) 

SELF. minPageFrame := inputFrame 


inputFrame := SELF. NewlnputFrame(phMaxPage, typeStyle, stdFrmeOffset, stdinputTypeStyle, 
borders, FALSE, FALSE); 

inputFrame. Suppl antContents('------ ne 

SELF. maxPageFrame := inputFrame 


cluster := SELF. NewCl uster( phAlignment); 

checkbox := cluster. NewCheckbox(phTopLeft, stdBoxWidth - 3, stdBoxHeight - 2, TRUE, 
label Offset, typeStyle, FALSE); 

checkbox := cluster. NewAli gnedCheckbox(phTopCenter, TRUE) 

checkbox := cluster. NewAli gnedCheckbox( phTopRi ght, FALSE) 


checkbox := cluster. NewCheckbox(phBotLeft, stdBoxWidth - 3, stdBoxHeight - 2, TRUE, 
label Offset, typeStyle, FALSE); {for second row} 

checkbox := cluster. NewAlignedCheckbox( phBotCenter, FALSE) 

checkbox := cluster. NewAlignedCheckbox( phBotRight, FALSE) 

SELF.alignCluster := cluster 


button := SELF. NewButton(phLaunchHeading, stdButtonMetrics, NIL, NoCmdNumber) ; 
SELF. AddOKButton( noCmdNumber ) 


MakeTypeStyle(famModern, sizelOPitch, [bold], typeStyle); 
legend := SELF. NewLegend(phPageMargins, typeStyl e) 


MakeTypeStyle(famModern, sizel2Pitch, [bold], typeStyle); 
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cluster := SELF. NewCluster( phUnits); 

SELF. unitsCluster := cluster 

checkbox := cluster. NewCheckbox(phinches, stdBoxWdth - 3, stdBoxHeight - 2, TRUE, 
label Offset, typeStyle, TRUE) 

checkbox := cluster. NewAli gnedCheckbox( phCenti meters, FALSE) 


MakeTypeStyle(famModern, sizel5Pitch, [], typeStyle) 

legend := SELF. AddStdLegend('0.25 0.50 0.75 1.00 
96, 140, typeStyle); 

SELF. marginTitle := legend 


1.25 1.50 1.75 2.00 2.25 2.50' 


boxSpacing := stdBoxSpacing + spcAdj ust ment; 


legend := SELF.NewLegend(phLeft, sysTypeStyle) 
cluster := SELF. NewRowOfBoxes(phLeftCluster, 10, 100, stdBoxWdth, 
stdBoxHei ght, boxSpacing); 
cluster,selectBox(TCheckbox(cluster. Obj ect With! DNumber(103))); {make this the real thing someday} 
SELF.leftCluster := cluster 


legend := SELF.NewLegend(phTop, sysTypeStyl e) 

cluster := SELF. NewRow0fBoxes(phTopCluster, 10, 200, stdBoxWidth, stdBoxHeight, boxSpacing); 
cluster.selectBox(TCheckbox(cluster. Object Wthl DNumber(203))); {make this the real thing someday} 
SELF.topCluster := cluster; 


legend := SELF. NewLegend(phRight, sysTypeStyle) 

cluster := SELF. NewRowOf Boxes(phRightCluster, 10, 300, stdBoxWidth, stdBoxHeight, boxSpacing) 
cluster.selectBox(TCheckbox(cluster. Object Wthl DNumber(303))); {make this the real thing someday} 
SELF.rightCluster := cluster 


legend := SELF. NewLegend(phBottom, sysTypeStyl e) 

cluster := SELF. NewRow0f Boxes(phBotCluster, 10, 400, stdBoxWidth, stdBoxHeight, boxSpacing); 
cluster.selectBox(TCheckbox(cluster. Object Wthl DNumber(403))); {make this the real thing someday} 
SELF. bottomCluster := cluster 


button := SELF. NewButton(phinstall Margins, stdButtonMetrics, NIL, noCmdNumber) 
SELF.extentLRect.topLeft := zeroLPt; {+SW+} 
{$IFC fTrace}EP; {$ENDC} 


{$1 FC fDebugMet hods} 


{$$ 


DI gDbg} 


PROCEDURE TPageStatusDialog.Fields( PROCEDURE Field(nameAndType: $255)); 


BEGI 


N 

SUPERSELF. Fields(Field); 
Field('currentHeading: THeading') 
Field('oddEvenCluster: TCluster') 
Field('minPageFrame: Tl nputFrame' ); 
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Field('maxPageFrame: Tl nputFrame'); 
Field('alignCluster: TCluster'); 
Field('unitsCluster: TCluster'); 
Field('marginTitle: TLegend'); 
Field('leftCluster: TCluster'); 
Field('topCluster: TCluster'); 
Field('rightCluster: TCluster'); 
Field('bottomCluster: TCluster'); 
Field(''); 

END; 

{$ENDC} 


{$$ HdgMarg} 


PROCEDURE TPageStatusDi al og. ButtonPushed( button 
VAR heading: THeading 
cluster: TCluster; 
hit Boxl D: INTEGER; 
theS255: $255: 
input Frame: Tl nput Frame 
mi nPage: LONGI NT; 
max Page: LONGI NT; 
pane: TPane; 


pageDesi gnWi ndow 
planner Vi ew 


TPageDesi gnWi ndow 
TPl anner Vi ew 


offset: LPoint 
| ayout Box: TLayout Box; 
pageAlignment: TPageAli gnment; 
checkbox: TCheckbox; 
oddOnl y: BOOLEAN 
evenOnl y: BOOLEAN 
newMar gins: LRect; 
panel: TPanel: 
inches: BOOLEAN 
planner Panel: TPanel; 
editLegendSelection: TEditLegendSel ecti 
noSel ection: TSel ection; 
FUNCTION Margin(cluster: TCluster; baselD 
VAR hitBox: TCheckbox; 
boxOrd: INTEGER 
BEGIN 
hitBox := cluster. hiLitBox: 
IF hitBox = NIL THEN 
boxOrd := 1 
ELSE 
boxOrd := hitBox.idNumber - baselD 


IF inches THEN 
Margin 
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TButton); 


on; 


INTEGER; vhs: 


+1 


vhSelect): 


INTEGER; 


:= (pageDesi gnWindow. hostView.res.vh[ vhs] * boxOrd) DIV 4 
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{because it's in quarter of inches right now} 
ELSE {operating in centimeters} 

Margin := LintDivint(pageDesignWi ndow. hostView.res.vh[ vhs] * boxOrd * ORD4(100), 508) 
END; 


{$I1FC fTrace}BP(11); {$ENDC} 

pageDesi gnWi ndow : = TPageDesi gnW ndow( SELF. view. panel. window); 

plannerView := TPlannerVi ew( pageDesi gnWi ndow. layout Panel. view); 

IF button.idNumber = phLaunchHeading THEN {launch a heading AND a corresponding new layout box} 


BEGIN 
offset := zeroLPt; {default in case no...} 
cluster := SELF.alignCluster; 
IF cluster. hilitBox = NIL THEN 
cluster. Select Box(TCheckbox(cluster. Obj ect Wthl DNumber( phTopCenter))); {bullet proofing? } 


SELF.I nspectHeadingParms(oddOnly, evenOnly, pageAlignment, minPage, maxPage) 


CASE pageAlignment OF 


aTopLeft: SetLPt(offset, 80, 30) 
aTopCenter: SetLPt(offset, 0, 30) 

aTopRi ght: SetLPt(offset, -80, 30) 
aBottomLeft: SetLPt(offset, 80, -30) 


aBottomCenter: SetLPt(offset, 0, -30) 
aBottomRi ght: SetLPt(offset, -80, -30) 
END; {CASE} 


|F minPage = maxPage THEN 
1F odd(minPage) THEN 
evenOnly := FALSE 
ELSE 
oddOnly := FALSE; {keep user fromlaunching a nowhere-printable heading} 


heading := TLegendHeading. CREATE(NIL, SELF.Heap, pageDesignWi ndow. host Vi ew. print Manager 
dfltNewHeading, stdHdngTypeStyle, pageAlignment, offset, stdHdngBorders) 


heading. mi nPage 
heading. maxPage 


= mi nPage; 
= maxPage; 
heading. oddOnly := oddOnl y; 
heading. evenOnly := evenOnl y; 


PushFocus; 
TPane(SELF. view. panel.panes. First). Focus; {so that thePad will be set to something} 


pageDesi gnWi ndow. host View. pri ntManager. headings. | nsLast(headi ng) 


heading. Adj ustForPage(0, TRUE); 
heading. LocateOnPage( TRUE) ; 
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SELF.currentHeading := heading 
layoutBox := plannerView. NewLayout Box( heading) 
1F layoutBox <> NIL THEN 
BEGIN 
plannerPanel := plannerVi ew. panel 
planner View. root Dial og. Addl mage(| ayout Box) 
planner Panel. Begi nSel ection; 
editLegendSelection := TEditLegendSel ection( pl annerPanel.sel ection. FreedAndRepl acedBy( 
TEditLegendSelection. CREATE(NIL, SELF. Heap 
TLgHdngLayout Box(| ayout Box).]egendLayoutBox, zeroLPt))); 
editLegendSel ection. coSel ection, Become( 
editLegendSel ection. text Di al ogl mage.textl mage. text.SelectAl | ( 
editLegendSel ection. text Di al ogl mage. text! mage) ); 
plannerPanel. I nvalLRect(layoutBox. extentLRect); 
plannerView. currentLayoutBox := | ayoutBox; 
END; 


TDi al ogVi ew(SELF. view). AbandonThatButton; {turn off highlighting} 
PopFocus; 
current Window. PerformCommand(TCommand. CREATE(NIL, SELF.Heap, uCmdLaunchHeading, plannerView 


FALSE, revealAll)); 
END 


IF button.idNumber = phinstall Margins THEN 


BEGIN 

inches := SELF. unitsCluster. hilitBox.idNumber = phinches 

newMargins. left := Margin(SELF.leftCluster, 100, h); 

newMargins.top := Margin(SELF.topCluster, 200, v) 

newMargins. right := Margin(SELF.rightCluster, 300, h) 

newMargins. bottom := Margin(SELF.bottomCluster, 400, v); 

pageDesi gnWi ndow. host View. print Manager. ChangeMar gi ns( newMar gi ns) 

TDi al ogVi ew(SELF. view). AbandonThatButton; {turn off highlighting} 

plannerView. panel. I nvalLRect(plannerView. extentLRect); {redraw layout panel with chgd margins} 

current Window. PerformCommand(TCommand. CREATE(NIL, SELF.Heap, uCmdinstal!l Margins, plannerView 
FALSE, reveal None)); 

END 


{ok button} 
BEGIN 
panel := plannerVi ew. panel 


panel. window. Commi tLast; 
noSelection := panel. undoSelection. FreedAndRepl acedBy( panel. view. NoSel ecti on) 
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001004 panel. selection. Deselect; 

001005 SUPERSELF. ButtonPushed( button); {will give OK dismissal to dialog} 
001006 END; 

001007 

001008 {$1 FC fTrace}EP; {$ENDC} 

001009 END; 

001010 

001011 

001012 {$8 HdgMarg} 

001013 PROCEDURE TPageStatusDialog.InspectHeadingParms(VAR oddOnly, evenOnly: BOOLEAN 
001014 VAR pageAlignment: TPageAlignment; VAR minPage, maxPage: LONGI NT); 
001015 VAR heading: THeadi ng; 

001016 newPageAl i gnment: TPageAl i gnment 

001017 theS255: $255; 

001018 checkbox: TCheckbox; 

001019 cState: TConvResul t; 

001020 BEGIN 

001021 {$I1FC fTrace}BP(11); {$ENDC} 

001022 checkbox := SELF. oddEvenCluster. hi Lit Box; 

001023 

001024 IF checkbox = NIL THEN 

001025 BEGIN 

001026 oddOnly := FALSE; 

001027 evenOnly := FALSE; 

001028 END 

001029 ELSE 

001030 BEGIN 

001031 oddOnly := (checkbox.idNumber = phOddOnl y) 
001032 evenOnly := (checkbox.idNumber = phEvenOnl y) 
001033 END; 

001034 

001035 checkbox := SELF. alignCluster. hilitBox; 

001036 IF checkbox = NIL THEN 

001037 pageAlignment := aTopCenter 

001038 ELSE 

001039 CASE checkbox.idNumber OF 

001040 phTopLeft: pageAlignment := aTopLeft; 
001041 phTopCenter: pageAlignment := aTopCenter 
001042 phTopRi ght: pageAlignment := aTopRi ght; 
001043 phBot Left: pageAlignment := aBottomLeft; 
001044 phBot Center: pageAlignment := aBottomCenter 
001045 phBot Ri ght: pageAlignment := aBottomRi ght; 
001046 END; 

001047 

001048 SELF. maxPageFrame, Get Contents(the$255); 

001049 StrToLI nt(@theS255, maxPage, cState) 

001050 IF (cState <> cvValid) OR (maxPage <= 0) THEN 
001051 BEGIN 
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maxPage := MAXLINT; 
SELF. maxPageFrame. Suppl antContents('------ '); 
END; 


SELF. mi nPageFrame. Get Contents(theS255); 
StrToLI nt(@theS255, minPage, cState); 
IF (cState <> cvValid) OR (minPage > maxPage) THEN 


BEGIN 

minPage := 1; 

SELF. mi nPageFrame. Suppl antContents('1'); 
END; 


{$1 FC fTrace}EP; {$ENDC} 
END; 


{$$ HdgMarg} 
PROCEDURE TPageStatusDi al og. SetHeadingParms(oddOnly, evenOnl y: 
pageAlignment: TPageAlignment; minPage 


VAR heading: THeadi ng; 
newPageAlignment: TPageAl i gnment 
theS255: $255; 
checkbox: TCheckbox; 
targetl D: INTEGER; 

BEGIN 


{$I1FC fTrace}BP(11); {$ENDC} 
1F oddOnly THEN 

targetID := phOddOnl y 
ELSE 
1F evenOnl y THEN 

targetID := phEvenOnl y 
ELSE 

targetID := phOddOrEven; 


max Page: 


BOOLEAN; 


LONGI NT); 


SELF. oddEvenCluster. Sel ect Box( TCheckbox( SELF. oddEvenCl uster. Obj ect Wthl DNumber(target! D))) 


CASE pageAlignment OF 


aTopLeft: targetID := phTopLeft; 
aTopCenter: targetID := phTopCenter 
aTopRi ght: targetID := phTopRi ght; 
aBottomLeft: targetID := phBotLeft; 
aBottomCenter: targetID := phBotCenter 
aBottomRi ght: targetID := phBotRi ght; 


END; 


SELF. alignCluster. Sel ect Box( TCheckbox( SELF. alignCluster. Obj ect Wthl DNumber(target!D))); 


IntToStr(minPage, @theS255); 
SELF. mi nPageFrame. Suppl antCont ents(theS255) 
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IF maxPage = maxLIint THEN 
theS255 := '---+--- : 
ELSE 
IntToStr(maxPage, @theS255); 
SELF. maxPageFrame. Suppl antCont ents(theS255) 
{$1 FC fTrace}EP; {$ENDC} 


END; 
Hdg Mar g} 
PROCEDURE TPageStatusDi al og. CheckboxHit(checkhox: TCheckbox; toggleDirection: BOOLEAN); 
VAR heading: THeadi ng; 
newPageAl i gnment: TPageAl i gnment 
newTitle: $255; 
phi ndex: INTEGER; 
dummy: LPoint; 
BEGIN 


{$1FC fTrace}BP(11); {$ENDC} 
IF checkBox. parent = SELF.unitsCluster THEN 
BEGIN 
IF checkbox.idNumber = phi nches THEN 
phindex := phinchTitle 
ELSE 
phindex := phCmTitle; 
Get TextAndLocation(phindex, newTitle, dummy); 
SELF. marginTitle. ChangeString( newTitle) 


END; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


HdgMar g} 
FUNCTION TPageStatusDi alog. DownAt(mouseLPt: LPoint): TDialogl mage 
BEGI N 

{$IFC fTrace}BP(11); {$ENDC} 

SELF. currentHeading := NIL; 

DownAt := SUPERSELF. DownAt( mouseLPt); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


HdgMarg} 
PROCEDURE TPageStatusDi al og. Draw 
CONST horizLine = 100 
vertLine = 570 
BEGI N 
{$I1FC fTrace}BP(11); {$ENDC} 
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SUPERSELF. Draw; {draw the dialog} 

MoveToL(0, horizLine); 

PenNor mal 

PenSize(3, 2); 
LineToL(SELF. view. extentLRect. right, horizLine) 
MoveToL(vertLine, 0); 

LineToL(vertLine, horizLine); 

{$1 FC fTrace}EP; {$ENDC} 


001160 {$$ Digi nit} 


001161 END; 


001162 
001163 


End of File -- 


Lines: 1163 Characters: 41596 
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FILE: "LI BTK/ UDRAW, TEXT" 


000001 UNIT UDraw 

000002 {Copyright 1983, 1984, Apple Computer, Inc. } 

000003 

000004 {changed 05/01 1503 Changes to allow people to use Clascal on the Workshop} 
000005 

000006 {$Setc Isintrinsic := TRUE } 

000007 

000008 {$I1FC Isintrinsic} 

000009 INTRINSIC; 

000010 {$ENDC} 


000011 

000012 INTERFACE 

000013 

000014 USES 

000015 {$U UnitStd } UnitStd, {Client should not USE UnitStd} 
000016 {$U Unit Hz } UnitHz, {Client should not USE UnitHz and MUST NOT USE Storage} 
000017 {$U libtk/UObj ect} UObj ect, {Client must USE UObj ect} 
000018 {$U - #BOOT-SysCall} SysCall, {Client may USE SysCall} 
000019 {$lFC LibraryVersion > 10} 

000020 {$U LI BPL/PaslibCall} PaslibCal| 

000021 {$U LIBPL/PPasLibc } PPasLibC 


000022 {$ENDC} 
000023 {$IFC LibraryVersion <= 20} 


000024 {$U Font Mgr } Font Mgr, {Client should USE UFont instead of FontMgr before QuickDraw} 
000025 {$ENDC} 

000026 {$U QuickDraw } QuickDraw, {Client must USE QuickDraw (unless we provide a type-stub for it)} 
000027 {$lFC LibraryVersion > 20} 

000028 {$U Font Mgr } Font Mgr, {Client should USE UFont instead of FontMgr after QuickDraw} 
000029 {$ENDC} 

000030 {$U WM. Events } Events, 

000031 {$U WM. Folders } Folders 

000032 {$U FilerComm  } FilerComm; 

000033 

000034 {$SETC fDbgDraw := f DbgOK} 

000035 {$SETC fRngDraw := f DbgOK} 

000036 {$SETC fSymDraw = f Sym0K} 

000037 


000038 {$SETC fDebugMethods := fDbgDraw} {if VAR also true, trace entries and/or exits} 
000039 
000040 CONST 


000041 {there should be at most 10 families and they should be in consecutive order; otherwise 
000042 the command number constants in UABC should be changed} 
000043 famSystem = 0; 
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000044 

000045 famMi n = 1; {minimum family number that appears in the font menu} 
000046 famModern Sy ae 

000047 famClassic = 2 

000048 f amMax 7 2; 

000049 

000050 {there should be at most 20 families and they should be in consecutive order; otherwise 
000051 the command number constants in UABC should be changed} 

000052 sizeMin = 1; 

000053 size20Pitch = 1; { 8 Point 20 Pitch NOTE: Modern available only} 
000054 sizel5Pitch = 2: { 8 Point 15 Pitch NOTE: Modern available only} 
000055 sizel2Pitch = 3: {10 Point 12 Pitch} 

000056 sizelQPitch = 4: {12 Point 10 Pitch} 

000057 sizel2Point = 5; {12 Point proportional } 

000058 sizel4Point = 6; {14 Point proportional } 

000059 sizel8Point = 7; {18 Point proportional } 

000060 size24Point = 8; {24 Point proportional } 

000061 sizeMax = 8; 

000062 

000063 {font IDs to be used in QuickDraw} 

000064 fl DSystem = 0; {Reserved for application generated text, that cannot be edited by user 
000065 does not print properly} 

000066 f1D20Pitch = 19; 

000067 f1DI5Pitch = 7; 

000068 fl Dml2Pitch = 8; 

000069 fl Dcl2Pitch = 13; 

000070 fl Dml0Pitch = 9; 

000071 fl Dcl0Pitch = 14; 

000072 f | Dm12Poi nt 7 4: 

000073 f1Dc12Poi nt = 10; 

000074 f | Dm 4 Poi nt = 15; 

000075 fl Dc14Poi nt = 16; 

000076 f | Dm18Poi nt = 5; 

000077 f 1 Dc18Poi nt ] 11; 

000078 f 1 Dm24Poi nt = 6; 

000079 f 1 Dc24Poi nt = 12; 

000080 

000081 fl DRulers = 25: {Ruler Icons} 

000082 

000083 {fontlDs below this line are to be used only in special cases, there is no guarantee that these 
000084 will print properly} 

000085 fl DSysPatterns = 2; {System Patterns, ie. LisaDraw} 

000086 flDSysCursors = 3; {System Cursors} 

000087 fIDLT20Graphics = 23; {LisaTerminal 20 Pitch VT100 graphics} 

000088 fIDLT12Graphics = 17; {LisaTerminal 12 Pitch VT100 graphics} 

000089 fl DLT20Text = 27; {LisaTerminal 20 Pitch VT100 text} 

000090 fl DLT12Text = 26; {LisaTerminal 12 Pitch VT100 text} 

000091 fl DDeskl cons = 22; {Desktop Icon font} 
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f | DWM = 1; {Window Manager font} 
fl DCalculator = 18; {Calculator font} 

f1 DI conName = 21; {Icon Name font} 

fl DMarker = 20; {Marker Font} 

fl DLisaGuide = 24; {LisaGuide Font} 


TFontl DArray = ARRAY[famMin..famMax, sizeMin..sizeMax] OF INTEGER; 


TScaler = 
RECORD {scale- definition} 
numerator: point; {numerator.h DIV denominator.h is the scale factor in horiz direction} 
denomi nator: point; {numerator.v DIV denominator.v is the scale factor in the vert. direction} 
END; 


TRectCoords = ARRAY[FALSE.. TRUE] OF Point; {TRectCoords(aRect)[FALSE] = aRect.topLeft; [TRUE] = botRi ght} 


LPoint = 
RECORD 
CASE INTEGER OF 
0: (v, h: LONGINT); 
1: (vh: ARRAY [VHSelect] OF LONGI NT) 
END; 
LRect = 
RECORD 


CASE INTEGER OF 
0: (top, left, bottom, right: LONGINT); 
1: (topleft, botRight: LPoint) 
END; 
LPattern = PACKED ARRAY[0..7] OF 0..255; 
TLRectCoords = ARRAY[FALSE..TRUE] OF LPoint; {TLRectCoords(anLRect)[FALSE] = anLRect.topLeft; etc. } 


TEnumActions = (rErase, rFrame, rBackground, rDraw) 
TActions = SET OF TEnumActi ons; 


THighTransit = (hNone, hOffToDim, hOffToOn, hDimToOn, hDimToOff, hOnToOff, hOnToDi m) 
{Refresh assumes that the last four and only the last four start with already-highlighted stuff} 


TEnumResizability = (userCanResizelt, windowCanResi zelt); 
TResizability = SET OF TEnumResizability; {arg for TBranchArea. CREATE & TPanel. Di vide} 


TFontRecord = 
PACKED RECORD 
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000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
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000159 
000160 
000161 
000162 
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000168 
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000170 
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000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 


CASE BOOLE 
FALSE: 
TRUE: 


END; 


TTypeStyle = 
RECORD 
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AN OF 
(font Num: INTEGER); 
(font Family: Byte 
fontSi ze: Byte) 


{$1FC LibraryVersion <= 20} 
TSeteface: 


onFaces: 
{$ELSEC} 

onFaces: 
{$ENDC} 

font: 

END; 


Style; 


TFont Record: 


TArea = SUBCLASS OF TObj ect 


{Variables} 
innerRect: 
outerRect: 
parent Bran 


ch: 


Rect; {window(usually)-relative bounds excluding borders} 
Rect; {bounding box in ancestral coordinates} 
TBranchArea: {only used for TPanels and TBranchAreas} 


{Creation/ Destruction} 
FUNCTION TArea. CREATE(object: TObject; heap: THeap; itsRect: Rect): TArea; ABSTRACT; 


{Attributes} 
FUNCTI ON 
PROCEDURE 


PROCEDURE 
PROCEDURE 
PROCEDURE 


{Display} 
PROCEDURE 


PROCEDURE 
PROCEDURE 
PROCEDURE 


{But toning} 
FUNCTI ON 


TArea. 
TArea. 


TArea. 
TArea. 
TArea. 
TArea. 
TArea. 
TArea. 


TArea. 


TArea. 


ChildWithPt(pt: Point; childList: TList; VAR nearestPt: Point): TArea; 
Get Border(VAR border: Rect); DEFAULT; 
{Return the deltas of the border bars, etc. (outer=inner+border) } 
{windows, bands, panes: 1 all around 
panels: 1 on left/top, scroll bars on right/ bottom} 
Get Mi nExtent(VAR minExtent: Point; windowlsResizinglt: BOOLEAN); ABSTRACT; 
Set OuterRect(newOuterRect: Rect); 
Seti nnerRect(newl nnerRect: Rect); 


{Other methods assume grafPort, origin, & clipping were preset by Focus} 
Erase; 

{Erase the interior} 
Focus; ABSTRACT; 

{Set up the grafPort for this window or pad} 
Frame; DEFAULT; 

{Draw outlines, scroll bars, etc. outside the bounding box} 
Refresh(rActions: TActions; highTransit: THighTransit); ABSTRACT; 


DownAt(mousePt: Point): BOOLEAN; ABSTRACT; 
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{Resizing} 
PROCEDURE TArea. Resizelnside(newlnnerRect: Rect); ABSTRACT; 
PROCEDURE TArea. ResizeOutside(newOuterRect: Rect); ABSTRACT; 


END; 


TPad = SUBCLASS OF TArea 


{Variables} 
port: Graf Ptr; {the GrafPort used by this pad} 
viewedLRect: LRect; {The portion of view that is displayed in innerRect} 
visLRect: LRect; {viewedLRect sect visRgn while focused} 
avail LRect: LRect; {The larger part of view that fits in a 16-bit Rect} 
scroll Offset: LPoint; {The distance scrolled fromthe view topLeft} 
origin: Poi nt; {What to set the grafport origin to when focused} 
cdOffset: LPoint; {What to subtract from coordinates to get port coords} 
clippedRect: rect; {additional clipping to apply at Focus time} 
padRes: Poi nt; {spots/inch in the pad coordinate space} 
vi ewedRes: Poi nt; {spots/inch in the 32-bit space being projected} 
scaled: BOOLEAN; {the net scale factor, combining zooming} 
scaleFactor: TScaler; {and aspect ratio, etc. } 
zoomFactor: TScaler: 


{Creation/ Destruction} 
FUNCTION TPad.CREATE(object: TObject; heap: THeap; itsIlnnerRect: Rect; itsViewedLRect: LRect; 
itsPadRes, itsViewRes: Point; 
itsPort: GrafPtr): TPad 


PROCEDURE TPad. Redefine(itsIlnnerRect: Rect; itsViewedLRect: LRect; 
itsPadRes, itsViewRes: Point; 
itsZoomFactor: TScaler; itsPort: GrafPtr); 


{Coordinate Mapping -- grafPort to view} 
PROCEDURE TPad. DistToLDist(distInPort: Point; VAR I DistI nView: LPoint); 
PROCEDURE TPad. PatToLPat(patInPort: Pattern; VAR | PatInView: LPattern); 
PROCEDURE TPad. PtToLPt(ptinPort: Point; VAR | PtInView: LPoint); 
PROCEDURE TPad. RectToLRect(rectInPort: Rect; VAR |RectInView: LRect); 


{Coordinate Mapping -- view to graf Port} 
PROCEDURE TPad. LDistToDist(|I DistIinView: LPoint; VAR distI nPort: Point); 
PROCEDURE TPad. LPatToPat(|PatIinView: LPattern; VAR patIinPort: Pattern); 
PROCEDURE TPad. LPtToPt(I PtInView: LPoint; VAR ptInPort: Point); 
PROCEDURE TPad. LRectToRect(|RectinView: LRect; VAR rectIinPort: Rect); 
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{Scrolling} 
PROCEDURE TPad. OffsetBy(deltaLPt: LPoint); {offset viewedLRect -- no effect on display} 
PROCEDURE TPad. SetScrollOffset( VAR newOffset: LPoint); 
{recalculates the origin and cdOffset fields; does not change arg} 


{Display} 
PROCEDURE TPad. ClipFurtherTo(rBand: rect); {narrows down clip area at next Focus} 
PROCEDURE TPad. Focus; OVERRIDE; 


PROCEDURE TPad. I nvalLRect(r: LRect); {Force redraw of r at next update} 

PROCEDURE TPad.InvalRect(r: Rect); {Force redraw of r at next update} 

PROCEDURE TPad.SetPen(pen: PenState); {NB: We should later augment this so that it scales 
pensi zes} 


PROCEDURE TPad. Set PenToHi ghlight(highTransit: THighTransit); {SetPenState to highlight this way} 
PROCEDURE TPad. Set ZoomFactor(zoomNumerator, zoomDenomi nator: point); DEFAULT; 


{Drawing} 
PROCEDURE TPad. DrawLText(textBuf: Ptr; startByte, numBytes: INTEGER) 
PROCEDURE TPad. DrawLLi ne(newLPt: LPoi nt); 
PROCEDURE TPad. DrawLPicture(pic: PicHandle; r:LRect); 
PROCEDURE TPad. DrawLRect(verb: GrafVerb; r: LRect); 
PROCEDURE TPad. DrawLRRect(verb: GrafVerb; r: LRect; oval Width, ovalHeight: INTEGER) 
PROCEDURE TPad. DrawLOval(verb: GrafVerb; r: LRect); 
PROCEDURE TPad. DrawLArc(verb: GrafVerb; r: LRect; startAngle, arcAngle: INTEGER) 
PROCEDURE TPad. DrawLBits(VAR srcBits: BitMap; VAR srcRect: Rect; 
VAR dstLRect: LRect; mode: INTEGER; maskRgn: RgnHandl e) 


{Process termination and Debugging Assistance} 
PROCEDURE TPad. Crash; ABSTRACT; 
FUNCTION TPad. BindHeap(activeVsClip, doBind: BOOLEAN): THeap; ABSTRACT; 
END; 


TBranchArea = SUBCLASS OF TArea 


{Variables} 
arrangement: VHSel ect; {v means above one another } 
elderFirst: BOOLEAN; {TRUE IFF elderChild is above or to the left of youngerChil d} 
resizability: TResizability; 
elderChild: TArea; 


youngerChild: TArea; 


{Creation/ Destruction} 
FUNCTION TBranchArea. CREATE(object: TObject; heap: THeap; vhs: VHSelect; hasElderFirst: BOOLEAN; 
whoCanResizelt: TResizability; 
itsElderChild, itsYoungerChild: TArea): TBranchArea; 
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{Attributes} 
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PROCEDURE TBranchArea. 
FUNCTION TBranchArea. 
PROCEDURE TBranchArea. 
FUNCTION TBranchArea. 


{Resizing} 


PROCEDURE TBranchArea. 
PROCEDURE TBranchArea. 


END; 


amPri nti ng: 


zeroPt: 
zeroRect: 
hugeRect: 


zeroLPt: 
zeroLRect: 
hugeLRect: 


orthogonal : 
hi ghPen: 


| Pat White: 
| Pat Bl ack: 
| PatGray: 

| PatLtGray: 
| Pat DkGray: 


focusStack: 
focusStkPtr: 
focusArea: 
focusRgn: 
padRgn: 

alt VisRgn: 


useAl t VisRgn: 


thePad: 


noPad: 
crashPad: 


Get Mi nExtent(VAR minExtent: Point; windowlsResizinglt: BOOLEAN); OVERRIDE; 
OtherChild( child: TArea): TArea; 

ReplaceChild(child, newChild: TArea); 

TopLeftChild: TArea; 


ResizeOutside(newOuterRect: Rect); OVERRIDE; 
Redivide(newCd: INTEGER); 


BOOLEAN; {lff TRUE, we are currently printing rather than drawing} 
Poi nt; {(0,0)} 

Rect; {(0,0)-(0,0 

Rect; {(0, 0) -( MAXI NT/ 2, MAXI NT/ 2) } 

LPoint; {(0,0)} 

LRect; {(0,0)-(0,0 

LRect; {(0,0)-(MAXLINT/ 2, MAXLINT/ 2) } 

ARRAY [v..h] OF VHSelect; {Maps v to h and vice versa} 

ARRAY [THighTransit] OF PenState; {standard highlight-feedback transitions} 
LPattern; {Maps to QuickDraw pattern white} 

LPattern; {Maps to QuickDraw pattern black} 

LPattern; {Maps to QuickDraw pattern gray} 

LPattern; {Maps to QuickDraw pattern ItGray} 

LPattern; {Maps to QuickDraw pattern dkGray} 

ARRAY [1..10] OF TArea; {PushFocus pushes and PopFocus pops focusArea} 
INTEGER; {Index of last thing on focusStack} 

TArea; {The currently focused area} 

RgnHandl e; {either padRgn or visRgn} 

RgnHandle; {intersection of pane and visRgn} 

RgnHandl e; {If useAltVisRgn, use this instead of visRgn in Focus} 
BOOLEAN; {If TRUE, use altVisRgn instead of visRgn in Focus} 
TPad; {focusArea, if a TPad, else NIL} 

TPad; {maps every point to itself} 

TPad; {an object willing to handle process termi nation} 
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screenRes: Poi nt; {screen resolution, pixels per inch} 
sysTypeStyle: TTypeStyle; {system font, normal face} 


printerPseudoPort: GrafPtr 


cArea: TClass: 
cPad: TClass: 
cBranchArea: TClass 


{The next four are declared EXTERNAL in UOBJ ECT2} 
PROCEDURE Init QDWM 

PROCEDURE TrmntExcepti onHandl er 

PROCEDURE InitErrorAbort(error: INTEGER); 

{$1 FC fDbgDraw} 

FUNCTION BindHeap(activeVsClip, doBind: BOOLEAN): THeap; 
{$ENDC} 


PROCEDURE Reduce(VAR numerator, denominator: INTEGER); {reduce fraction to lowest terms} 


FUNCTION FPtPlusPt(operandl, operand2: Point): LONGI NT; { p3 := Point(FPtPlusPt(pi, p2)); 


FUNCTION FPtMinusPt(operandl, operand2: Point): LONGI NT; { F stands for FUNCTION } 


FUNCTION FPtMullnt(operandl: Point; operand2: INTEGER): LONGI NT; 
FUNCTION FPtDivint(operandl: Point; operand2: INTEGER): LONGI NT; 


{e.g.: center := Point(FPtDivint(POINT(FPtPlusPt(pl, p2)), 2); } 

FUNCTION FPtMaxPt(operand1, operand2: Point): LONGI NT; { each coordinate is max'ed separately } 
FUNCTION FPtMinPt(operand1, operand2: Point): LONGINT; 
FUNCTION FDiagRect(operandi: Rect): LONGI NT; { FPtMinusPt(botRight-topLeft) } 
PROCEDURE Bool ToStr(bool: BOOLEAN; str: TPstring); 
FUNCTION LintDivLInt(i, j: LONGINT): LONGI NT; 
FUNCTION LintDivint(i: LONGINT; j: INTEGER): LONGI NT; 
FUNCTION LintMullnt(i: LONGINT; j: INTEGER): LONGI NT; 
FUNCTION LintOvrint(i: LONGINT; j: INTEGER): LONGI NT; 

{This returns LintDivlnt(i+(j DIV 2), j) if i>0 and 

LintDivint(i-(j DIV 2), j) if i<0} 
PROCEDURE PtPlusPt(operand1, operand2: Point; VAR result: Point); 
PROCEDURE PtMinusPt(operandl, operand2: Point; VAR result: Point); 
PROCEDURE PtMull nt(operand1: Point; operand2: INTEGER; VAR result: Point); 
PROCEDURE PtDivint(operand1: Point; operand2: INTEGER; VAR result: Point); 
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{$1FC LibraryVersion <= 20} 
FUNCTION Equal Pt(operand1, operand2: Point): BOOLEAN; {WII be in QuickDraw eventually} 
{$ENDC} 


PROCEDURE RectPlusRect(operand1, operand2: Rect; VAR result: Rect); 
PROCEDURE RectMinusRect(operandl, operand2: Rect; VAR result: Rect); 
{$1FC LibraryVersion <= 20} 


FUNCTION Equal Rect(rectA, rectB: Rect): BOOLEAN; {Will be in QuickDraw eventually} 
FUNCTION EmptyRect(r: Rect): BOOLEAN; {Will be in QuickDraw eventually} 
{$ENDC} 


PROCEDURE AlignRect(VAR dstRect: Rect; srcRect: Rect; vhs: VHSelect); 

FUNCTION LengthRect(r: Rect; vhs: VHSelect): INTEGER 

FUNCTION RectHasPt(dstRect: Rect; pt: Point): BOOLEAN 

PROCEDURE RectHavePt(dstRect: Rect; VAR pt: Point); {change pt so that topLeft <= pt <= botRi ght} 
FUNCTION RectsNest(outer, inner: Rect): BOOLEAN 

PROCEDURE RectifyRect(VAR dstRect: Rect); {exchange coordinates until topLeft <= botRi ght} 
FUNCTION RectIsVisible(rectIinPort: Rect): BOOLEAN 


PROCEDURE PointToStr(pt: Point; str: TPstring); {Referenced as EXTERNAL by UABC2} 
PROCEDURE RectToStr(r: Rect; str: TPstring); {Referenced as EXTERNAL by UABC2} 


PROCEDURE LPtPlusLPt(operand1, operand2: LPoint; VAR result: LPoint); 
PROCEDURE LPtMinusLPt(operandl, operand2: LPoint; VAR result: LPoint); 
PROCEDURE LPt Mull nt(operandl: LPoint; operand2: INTEGER; VAR result: LPoint); 
PROCEDURE LPtDivint(operandl: LPoint; operand2: INTEGER; VAR result: LPoint); 
FUNCTION EqualLPt(operand1, operand2: LPoint): BOOLEAN 


PROCEDURE LRectPlusLRect(operand1, operand2: LRect; VAR result: LRect); 
PROCEDURE LRectMinusLRect(operand1, operand2: LRect; VAR result: LRect); 
FUNCTION EqualLRect(rectA, rectB: LRect): BOOLEAN 

FUNCTION EmptyLRect(r: LRect): BOOLEAN 


PROCEDURE AlignLRect(VAR destLRect: LRect; srcLRect: LRect; vhs: VHSelect); 

FUNCTION LengthLRect(r: LRect; vhs: VHSelect): LONGI NT; 

FUNCTION LRectHasLPt(destLRect: LRect; pt: LPoint): BOOLEAN 

PROCEDURE LRectHaveLPt(destLRect: LRect; VAR pt: LPoint); {change pt so that topLeft <= pt <= botRi ght} 
FUNCTION LRectsNest(outer, inner: LRect): BOOLEAN 

PROCEDURE RectifyLRect(VAR destLRect: LRect); {exchange coordinates until topLeft <= botRi ght} 
FUNCTION LRectIsVisible(srcLRect: LRect): BOOLEAN 


PROCEDURE LPointToStr(pt: LPoint; str: TPstring); {Referenced as EXTERNAL by UOBJ ECT2} 
PROCEDURE LRectToStr(r: LRect; str: TPstring); {Referenced as EXTERNAL by UOBJ ECT2} 


PROCEDURE SetLPt(VAR destPt: LPoint; itsH, itsV: LONGINT); 
PROCEDURE SetLRect(VAR dstRect: LRect; itsLeft, itsTop, itsRight, itsBottom LONGI NT) 
PROCEDURE OffsetLRect(VAR dstRect: LRect; dh, dv: LONGI NT); 
PROCEDURE InsetLRect(VAR dstRect: LRect; dh, dv: LONGI NT); 
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000428 FUNCTION SectLRect(srcRectA, srcRectB: LRect; VAR dstRect: LRect): BOOLEAN; 
000429 PROCEDURE UnionLRect(srcRectA, srcRectB: LRect; VAR dstRect: LRect); 
000430 FUNCTION LPtinLRect(pt: LPoint; r: LRect): BOOLEAN 

000431 

000432 

000433 FUNCTION IsSmall Pt(srcPt: LPoint): BOOLEAN 

000434 FUNCTION IsSmallRect(srcRect: LRect): BOOLEAN; 

000435 

000436 

000437 (*PROCEDURE ClipLRect(r: LRect); {Not yet impl ementabl e}*) 
000438 

000439 

000440 {Drawing text} 

000441 

000442 PROCEDURE DrawLText(textBuf: Ptr; startByte, numBytes: INTEGER); 
000443 

000444 {Drawing lines, rectangles, and ovals} 

000445 

000446 PROCEDURE MoveToL(h, v: LONGINT); 

000447 PROCEDURE MoveL(dh, dv: LONGI NT) 

000448 PROCEDURE LineToL(h, v: LONGINT); 

000449 PROCEDURE LineL(dh, dv: LONGI NT) 

000450 

000451 PROCEDURE FrameLRect(r: LRect); 

000452 PROCEDURE PaintLRect(r: LRect); 

000453 PROCEDURE EraseLRect(r: LRect); 

000454 PROCEDURE InvrtLRect(r: LRect); 

000455 PROCEDURE FillLRect(r: LRect; | Pat: LPattern); 

000456 

000457 PROCEDURE FrameLOval(r: LRect); 

000458 PROCEDURE PaintLOval(r: LRect); 

000459 PROCEDURE EraseLOval(r: LRect); 

000460 PROCEDURE InvrtLOval(r: LRect); 

000461 PROCEDURE FillLOval(r: LRect; | Pat: LPattern); 

000462 

000463 PROCEDURE FrameLRRect(r: LRect; oval Width, oval Height: INTEGER); 
000464 PROCEDURE PaintLRRect(r: LRect; oval Width, oval Height: INTEGER); 
000465 PROCEDURE EraseLRRect(r: LRect; oval Width, oval Height: INTEGER); 
000466 PROCEDURE InvrtLRRect(r: LRect; oval Width, oval Height: INTEGER); 
000467 PROCEDURE Fill LRRect(r: LRect; oval Width, ovalHeight: INTEGER; | Pat: LPattern) 
000468 

000469 PROCEDURE FrameLArc(r: LRect; startAngle, arcAngle: INTEGER); 
000470 PROCEDURE PaintLArc(r: LRect; startAngle, arcAngle: INTEGER); 
000471 PROCEDURE EraseLArc(r: LRect; startAngle, arcAngle: INTEGER); 
000472 PROCEDURE InvrtLArc(r: LRect; startAngle, arcAngle: INTEGER); 
000473 PROCEDURE FillLArc(r: LRect; startAngle, arcAngle: INTEGER; | Pat: LPattern); 
000474 

000475 FUNCTION ClonePicture(pic: PicHandle; toHeap: THeap): PicHandle; 
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PROCEDURE ResizeFeedback( mousePt: Point; minPt, maxPt: Point; outerRect: Rect; 
tabHeight, sbWidth, sbHeight: INTEGER; VAR newPt: Point); 


PROCEDURE PushFocus; {Save old focusArea on focusStack} 


PROCEDURE PopFocus; {Restore old focusArea from focusStack and focus on it} 


{$1FC LibraryVersion <= 20} 

PROCEDURE MakeTypeStyle(itsFamily: INTEGER; itsSize: INTEGER 
itsFaces: TSetEFace 
VAR typeStyle: TTypeStyle); 

{$ELSEC} 

PROCEDURE MakeTypeStyle(itsFamily: INTEGER; itsSize: INTEGER 
itsFaces: Style; 
VAR typeStyle: TTypeStyle); 

{$ENDC} 


FUNCTION QDFontNumber(typeStyle: TTypeStyle): INTEGER 
PROCEDURE Set QDTypeStyle(typeStyle: TTypeStyle); 


| MPLEMENTATI ON 
{$l li btk/ UDRAW2, TEXT} 


END. 


File -- Lines: 504 Characters: 20727 
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000001 

000002 {INCLUDE FILE UDRAW2 -- | MPLEMENTATION OF UDRAW} 
000003 {Copyright 1983, 1984, Apple Computer, Inc. } 
000004 

000005 


000006 {changed 05/01 1503 Changes to allow people to use Clascal on the Workshop} 

000007 

000008 {Segments: SgABCini(tialize and Terminate), SgDRWres(ident), SgABCc(o)ld, SgABCdbg} 
000009 


000010 {$I FC fRngDraw} 

000011 {$R+} 

000012 {$ELSEC} 

000013 {$R-} 

000014 {$ENDC} 

000015 

000016 {$I FC fSymDraw} 

000017 {$D+} 

000018 {$ELSEC} 

000019 {$D-} 

000020 {$ENDC} 

000021 

000022 CONST 

000023 magi cNumber = 32768 
000024 

000025 VAR font!D: TFont! DArray 
000026 

000027 {$8 SgDRWres} 

000028 

000029 


000030 {$8 SgABCi ni } 
000031 PROCEDURE TrmntExcepti onHandl er 


000032 VAR ch: CHAR 

000033 error: INTEGER 

000034 BEGIN 

000035 IF onDesktop THEN 

000036 ImDying; {This must be done first} 
000037 

000038 1F NOT amDying THEN 

000039 BEGIN 

000040 {$1 FC fDbgDraw} 

000041 WriteLn('TrmntExceptionHandler'); 
000042 {$ENDC} 

000043 amDying := TRUE; 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 
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IF crashPad <> NIL THEN 
crashPad. Crash; 
END; 


{$1 FC fDbgDraw} 


{Flush the input queue in case there was user typeahead to the alternate screen} 


WHILE KeyPress DO 
Read(ch); 
{$ENDC} 


1F NOT onDesktop THEN 
MoveConsole(error, mainscreen); 
END; 
{$$ SgDRWres} 


{$$ SgABCi ni } 
PROCEDURE QkDrError(error: INTEGER); 
BEGIN 
{$1 FC fDbgDraw} 
ABCbreak('QkDrError', error); 
{$ENDC} 
HALT; 
END; 
{$$ SgDRWres} 


{$$ SgABCi ni} 
PROCEDURE Init QDWM 


VAR error: INTEGER 
workDir: Pat hname; 
boot Vol: e_ name; 
boot Dir: Pat hname; 
{$1FC LibraryVersion < 30} 

boot Port: tports; 
{$ENDC} 
BEGIN 


{$1 FC libraryVersion <= 20} 
InitGraf(@thePort, @QkDrError); 
{$ELSEC} 

InitGraf(@thePort); 

{$ENDC} 


crashPad := NIL; 
IF onDesktop THEN 


BEGIN 
OpenWM 
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000092 SetPort(deskPort); 

000093 wmlsI|nitialized := TRUE; 

000094 END 

000095 ELSE 

000096 BEGIN 

000097 {move WriteLns to alternate screen} 

000098 MoveConsole(error, alscreen) 

000099 {$IFC fDbgDraw} 

000100 1F error > 0 THEN 

000101 ABCBreak('MoveConsole error', error) 
000102 {$ENDC} 

000103 

000104 { set work directory to boot volume for FMOpen} 
000105 Get Working Dir(error, workDir) 

000106 {$I FC fDbgDraw} 

000107 1F error > 0 THEN 

000108 ABCBreak('Get_ Working Dir error’, error); 
000109 {$ENDC} 

000110 

000111 {$lFC LibraryVersion < 30} 

000112 boot Port := OSBootVol (error); 

000113 {$l FC fDbgDraw} 

000114 1F error > 0 THEN 

000115 ABCBreak('OSBootVol error', error); 
000116 {$ENDC} 

000117 

000118 Get Config Name(error, bootPort, bootVol) 
000119 {$I FC fDbgDraw} 

000120 1F error > 0 THEN 

000121 ABCBreak('Get_ Config Name error', error); 


000122 {$ENDC} 
000123 {$ELSEC} 


000124 OSBootVol(error, bootVol ) 

000125 {$l FC fDbgDraw} 

000126 1F error > 0 THEN 

000127 ABCBreak('OSBootVol error', error); 


000128 {$ENDC} 
000129 {$ENDC} 


000130 bootDir := CONCAT('-', bootVol); 

000131 

000132 Set Working Dir(error, bootDir) 

000133 {$l FC fDbgDraw} 

000134 IF error > 0 THEN 

000135 ABCBreak('Set Working Dir to boot vol error', error) 
000136 {$ENDC} 

000137 

000138 FMOpen(error); 


000139 {$l FC fDbgDraw} 
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000140 
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000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 


Apple Lisa Computer Technical Information 


1F error > 0 THEN 
ABCBreak('FMOpen error =', error); 
{$ENDC} 


{ Set work directory back after OpenWM } 

Set Working Dir(error, workDir) 
{$1 FC fDbgDraw} 

IF error > 0 THEN 

ABCBreak('Set_ Working Dir back to prefix error = ', error) 

{$ENDC} 

END; 
END; 
{$$ SgDRWres} 


{$8 SgABCdbg} 
FUNCTION BindHeap(activeVsClip, doBind: BOOLEAN): THeap 


BEGIN 
IF crashPad = NIL THEN 
BindHeap := NIL {no UABC to do it for me} 
ELSE 
BindHeap := crashPad. BindHeap(activeVsClip, doBind); 
END; 


{$$ SgDRWres} 


{$$ SgABCcl d} 
FUNCTION FilerReason(error: INTEGER): FReason: 
BEGIN 
{$1 FC fMaxTrace}BP( 1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
FilerReason := all Ok 
IF error > 0 THEN 
CASE error OF 


309: FilerReason := noDiskSpace 
315: FilerReason := noMemory 
4001: FilerReason := badData; 
OTHERW SE FilerReason := internal Error 
END; 


END: 
{$$ SgDRWres} 


{$$ SgABCi ni } 
PROCEDURE InitErrorAbort(error: INTEGER); 
BEGIN 
IF error > 0 THEN 
BEGIN 
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{$1 FC fDbgDraw} 
ABCbreak('InitErrorAbort', error); 
{$ENDC} 
1F onDesktop THEN 
Tell Filer(error, 
HALT; 
END 
ELSE 
IF wmisinitialized THEN 
1F Abort THEN 
BEGIN 
1F onDesktop THEN 


initFailed, FilerReason(error), NIL); 


Tell Filer(error, initFailed, aUserAbort, NIL); 
HALT; 
END; 
END; 
{$$ SgDRWres} 
{$$ SgDRWres} 
PROCEDURE Reduce(VAR numerator, denominator: INTEGER) 
VAR factor: INTEGER 
maxFactor: INTEGER; {also makes cosmetics} 
small erNumerator: INTEGER 
smallerDenomi nator: INTEGER 


BEGIN {very crude at the moment } 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 


maxFactor := MIN(numerator, denominator); 
FOR factor := maxFactor DOWNTO 2 DO 
BEGIN 


smallerNumerator := numerator DIV factor 
smallerDenomi nator := denominator DIV factor; 
IF (factor * smallerNumerator = 


BEGIN 

numerator := small erNumerator 
denominator := small erDenomi nator 
END; 


END; 
END; 


{$$ SgDRWres} 

FUNCTION FPtPlusPt(operandl, operand2: Point): 
VAR result: Point; 

BEGIN 


LONGI NT; 


{$I FC fMaxTrace}BP(1); {$ENDC} 
{$I FC fMaxTrace}EP: {$ENDC} 
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numerator) AND (factor * smallerDenomi nator = denominator) THEN 
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000236 
000237 
000238 
000239 
000240 
000241 
000242 
000243 
000244 
000245 
000246 
000247 
000248 
000249 
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000251 
000252 
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000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 


result.h: 
result.v:! 


FPt Pl usP 
END; 


{$$ SgDRWres 

FUNCTION FP 
VAR resu 

BEGIN 

{$l 

{$l 


F 
F 
result.h 


result.v: 


FPt Mi nus 
END; 


{$$ SgABCdat 
FUNCTION FP 
VAR resu 
BEGIN 
lF 
1F 
result.h 


result.v : 


FPt Mul ln 
END; 


{$$ SgABCdat 

FUNCTION FP 
VAR resu 

BEGIN 

{$l 

{$l 


F 
F 
result.h 


result.v: 


FPt Divin 
END; 


{$$ SgDRWres 

FUNCTION FP 
VAR resu 

BEGIN 

{$IF 

{SIF 
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operandl.h + operand2.h; 
operandl.v + operand2.v; 
t := LONGINT(result); 


} 
tMinusPt(operandl, operand2: Point): LONGI NT; 
lt: Point; 


f MaxTrace}BP( 1); {$ENDC} 

f MaxTrace}EP; {$ENDC} 
operandl.h - operand2.h; 
operandl.v - operand2.v; 
Pt := LONGI NT(result); 


C 
C 


} 
tMull nt(operand1l: Point; operand2: INTEGER): LONGI NT; 
It: Point; 


f MaxTrace}BP( 1); {$ENDC} 
f MaxTrace}EP; {$ENDC} 
operandl.h * operand2; 
operandl.v * operand2; 
t := LONGINT(result); 


C 
C 


} 
tDivint(operand1l: Point; operand2: INTEGER): LONGI NT; 
It: Point; 


f MaxTrace}BP( 1); {$ENDC} 

f MaxTrace}EP; {$ENDC} 
operandl.h DIV operand2; 
operandl.v DIV operand2; 
t := LONGINT(result); 


C 
C 


} 
tMaxPt(operand1, operand2: Point): LONGINT; 
lt: Point; 


C f MaxTrace}BP( 1); {$ENDC} 
C fMaxTrace}EP; {$ENDC} 
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result.h := Max(operandi.h, operand2. h) 
result.v := Max(operandi.v, operand2. v) 
FPt MaxPt := LONGI NT(result); 

END; 


{$$ SgDRWres} 
FUNCTION FPtMinPt(operand1, operand2: Point): LONGINT; 


VAR result: Point; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
result.h := Min(operandi.h, operand2. h) 
result.v := Min(operandi.v, operand2. v) 
FPt MinPt := LONGI NT(result); 
END; 
{$$ SgDRWres} 


FUNCTION FDiagRect(operandl: Rect): LONGI NT; 
VAR result: Point; 

BEGIN 

{$1FC fMaxTrace}BP(1); {$ENDC} 

{$1FC fMaxTrace}EP; {$ENDC} 

result.h := operandi. right - operand. left 

result.v := operandl. bottom - operand]. top; 

FDiagRect := LONGINT(result); 

END; 


{$$ SgABCdat } 
PROCEDURE Bool ToStr(bool: BOOLEAN; str: TPstring); 
BEGIN 

{$I FC fMaxTrace}BP( 1); {$ENDC} 


{$1FC fMaxTrace}EP; {$ENDC} 
1F bool THEN 
str* := ' TRUE’ 
ELSE 
str* := 'FALSE' 
END; 
FUNCTION LintDivLInt(i, j: LONGINT): LONGI NT; 


EXTERNAL; 


FUNCTION LintDivint(i: LONGI NT; j: INTEGER): LONGI NT; 
EXTERNAL; 
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FUNCTION LintMullnt(i: LONGI NT; j: INTEGER): LONGI NT; 
EXTERNAL; 


{$$ SgDRWres} 
FUNCTION LintOvrint(i: LONGI NT; j: INTEGER): LONGI NT; 


BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
1F i>0 THEN 
Lint Ovrint := LintDivint(i+(j DIV 2), j) 
ELSE 
Lint Ovrint := LintDivint(i-(j DIV 2), j); 
END; 
{$$ SgABCdat } 


PROCEDURE PtPlusPt(operand1, operand2: Point; VAR result: Point); 
BEGIN 

FC fMaxTrace}BP(1); {$ENDC} 

FC f MaxTrace}EP: {$ENDC} 

oh i= operand1.h + operand2. h; 

Vv := operandl.v + operand2. v; 


{$$ SgABCdat } 

PROCEDURE PtMinusPt(operandl, operand2: Point; VAR result: Point); 
BEGIN 

f MaxTrace}BP( 1); {$ENDC} 

f MaxTrace}EP; {$ENDC} 

operandl.h - operand2.h; 

operandl.v - operand2.v; 


{$$ SgABCdat } 
PROCEDURE PtMull nt(operand1: Point; operand2: INTEGER; VAR result: Point); 
BEGIN 


{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
result.h := operandl.h * operand2; 
result.v := operandl.v * operand2; 
END; 
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{$$ SgABCdat } 
PROCEDURE PtDivint(operand1: Point; operand2: INTEGER; VAR result: Point); 
BEGIN 


{$1 FC fMaxTrace}BP(1); {$ENDC} 

{$IFC fMaxTrace}EP; {$ENDC} 
result.h := operandi. h DIV operand2; 
result.v := operandl.v DIV operand2; 


{$1FC LibraryVersion <= 20} 
FUNCTION Equal Pt(operand1, operand2: Point): BOOLEAN 
BEGIN 
Equal Pt := (operand1.h = operand2.h) AND (operandl.v = operand2.v); 
END; 
{$ENDC} 


{$$ SgDRWres} 
PROCEDURE RectPlusRect(operand1, operand2: Rect; VAR result: Rect); 
BEGIN 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$I1FC fMaxTrace}EP; {$ENDC} 
result.left := operandl.left + operand2.left; 
result.top := operandl.top + operand2. top; 
result.right := operandi. right + operand2.ri ght; 
result. bottom := operand. bottom + operand2. bottom 
END; 


{$$ SgDRWres} 
PROCEDURE RectMinusRect(operandl, operand2: Rect; VAR result: Rect); 
BEGIN 
{$IFC fMaxTrace}BP(1); {$ENDC} 
{$1FC fMaxTrace}EP; {$ENDC} 
result.left := operandl.left - operand2.left; 
result.top := operandl.top - operand2.top; 
result.right := operandi. right - operand2.ri ght; 
result. bottom := operand. bottom ~- operand2. bottom 
END; 


{$1FC LibraryVersion <= 20} 
{$$ SgDRWres} 
FUNCTION Equal Rect(rectA, rectB: Rect): BOOLEAN 
BEGIN 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$I FC fMaxTrace}EP: {$ENDC} 
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Equal Rect := (rectA.left=rectB.left) AND (rectA.top=rectB.top) AND 
(rectA.right=rectB. right) AND (rectA. bottom=rectB. bottom); 
END; 


{$$ SgDRWres} 
FUNCTION EmptyRect(r: Rect): BOOLEAN; 
BEGIN 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
WTH r DO 
EmptyRect := (left >= right) OR (top >= bottom); 
END; 
{$ENDC} 


{$$ SgDRWres} 
PROCEDURE AlignRect(VAR dstRect: Rect; srcRect: Rect; vhs: VHSelect); 
BEGIN 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
dstRect.topLeft.vh[vhs] := srcRect.topLeft.vh[ vhs]; 
dstRect. botRight.vh[vhs] := srcRect. botRi ght. vh[vhs]; 
END; 


{$$ SgDRWres} 


FUNCTION LengthRect(r: Rect; vhs: VHSelect): INTEGER; 
BEGIN 
{$IFC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
LengthRect := r.botRight.vh[vhs] - r.topLeft.vh[vhs]; 
END; 
{$$ SgDRWres} 


FUNCTION RectsNest(outer, inner: Rect): BOOLEAN; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$I1FC fMaxTrace}EP; {$ENDC} 
RectsNest := RectHasPt(outer, inner.topLeft) AND RectHasPt(outer, inner. bot Right); 
END; 


{$$ SgDRWres} 
FUNCTION RectHasPt(dstRect: Rect; pt: Point): BOOLEAN; 
BEGIN 

{$I FC fMaxTrace}BP(1); {$ENDC} 
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000476 {$1FC fMaxTrace}EP; {$ENDC} 

000477 RectHasPt := (dstRect.left <= pt.h) AND (pt.h <= dstRect.right) AND 
000478 (dstRect.top <= pt.v) AND (pt.v <= dstRect. bottom) 
000479 END; 

000480 

000481 


000482 {$8 SgDRWres} 
000483 PROCEDURE RectHavePt(dstRect: Rect; VAR pt: Point); 
000484 BEGIN {if dstRect is negative size, left/top is forced} 


000485 {$IFC fMaxTrace}BP(1); {$ENDC} 

000486 {$IFC fMaxTrace}EP; {$ENDC} 

000487 pt.h := Max(dstRect.left, Min(dstRect.right, pt.h)); 
000488 pt.v := Max(dstRect.top, Min(dstRect. bottom, pt.v)); 
000489 END; 

000490 

000491 


000492 {$8 SgDRWres} 
000493 PROCEDURE RectifyRect(VAR dstRect: Rect); 
000494 BEGIN 


000495 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000496 {$IFC fMaxTrace}EP; {$ENDC} 

000497 Pt2Rect(dstRect.topLeft, dstRect. botRight, dstRect); 
000498 END; 

000499 

000500 


000501 {$8 SgDRWres} 
000502 FUNCTION RectlsVisible(rectI nPort: Rect): BOOLEAN 
000503 BEGIN 


000504 {$1FC fMaxTrace}BP(1); {$ENDC} 

000505 {$IFC fMaxTrace}EP; {$ENDC} 

000506 RectisVisible := RectIl nRgn(rectinPort, focusRgn); 
000507 END; 

000508 

000509 


000510 {$8 SgABCdbg} 
000511 PROCEDURE PointToStr(pt: Point; str: TPstring); 


000512 VAR s: $255: 

000513 BEGIN 

000514 {$1 FC fMaxTrace}BP( 1); {$ENDC} 
000515 {$I1FC fMaxTrace}EP; {$ENDC} 

000516 IntToStr(pt.h, str) 

000517 IntToStr(pt.v, @s); 

000518 str* := CONCAT('(', str%, ',', $, ')')3 
000519 END; 

000520 

000521 


000522 {$8 SgABCdbg} 
000523 PROCEDURE RectToStr(r: Rect; str: TPstring); 
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VAR s: $255; 
BEGIN 

{$1FC fMaxTrace}BP(1); {$ENDC} 

{$IFC fMaxTrace}EP; {$ENDC} 
PointToStr(r.topLeft, str); 
PointToStr(r.botRight, @s); 
str* := CONCAT('[', str’, ',', 8, ']')3 

END; 
{$$ SgDRWres} 


{$$ SgDRWres} 
PROCEDURE LPtPlusLPt(operand1, operand2: LPoint; VAR result: LPoint); 
BEGIN 


{$1 FC fMaxTrace}BP(1); {$ENDC} 

{$IFC fMaxTrace}EP; {$ENDC} 
result.h := operandi. h + operand2.h; 
result.v := operandl.v + operand2. v; 


{$$ SgDRWres} 
PROCEDURE LPtMinusLPt(operandl, operand2: LPoint; VAR result: LPoint); 
BEGIN 


{$1FC fMaxTrace}BP(1); {$ENDC} 

{$1FC fMaxTrace}EP; {$ENDC} 
result.h := operandl.h - operand2.h; 
result.v := operandl.v - operand2. v; 


{$$ SgABCdat } 
PROCEDURE LPt Mull nt(operandl: LPoint; operand2: INTEGER; VAR result: LPoint); 
BEGIN 


{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
result.h := operandl.h * operand2; 
result.v := operandl.v * operand2; 


{$$ SgABCdat } 
PROCEDURE LPtDivint(operandl: LPoint; operand2: INTEGER; VAR result: LPoint); 
BEGIN 


{$IFC fMaxTrace}BP(1); {$ENDC} 

{$IFC fMaxTrace}EP; {$ENDC} 
result.h := LintDivlnt(operandl.h, operand2); 
result.v := LintDivlnt(operandl.v, operand2); 
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END; 


{$$ SgDRWres} 
FUNCTION EqualLPt(operand1, operand2: LPoint): BOOLEAN 


BEGIN 
{$1FC fMaxTrace}BP( 1); {$ENDC} 
{$I1FC fMaxTrace}EP; {$ENDC} 
Equal LPt := (operandi. h = operand2.h) AND (operandl.v = operand2.v) 
END; 


{$$ SgDRWres} 
PROCEDURE LRectPlusLRect(operandl, operand2: LRect; VAR result: LRect); 
BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
{$1FC fMaxTrace}EP; {$ENDC} 
result.left := operandl.left + operand2.left; 
result.top := operandl.top + operand2. top; 
result.right := operandi. right + operand2.ri ght; 
result. bottom := operand. bottom + operand2. bottom 
END; 


{$$ SgDRWres} 
PROCEDURE LRect MinusLRect(operand1, operand2: LRect; VAR result: LRect); 
BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
result.left := operandl.left - operand2.left; 
result.top := operandl.top - operand2.top; 
result.right := operandi. right - operand2.ri ght; 
result. bottom := operandl. bottom ~- operand2. bottom 
END; 


{$$ SgDRWres} 
FUNCTION EqualLRect(rectA, rectB: LRect): BOOLEAN 


BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
EqualLRect := (rectA.left=rectB. left) AND (rectA.top=rectB.top) AND 
(rectA.right=rectB. right) AND (rectA. bottom=rectB, bottom); 
END; 


{$$ SgDRWres} 
FUNCTION EmptyLRect(r: LRect): BOOLEAN 
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000620 BEGIN 


000621 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000622 {$IFC fMaxTrace}EP; {$ENDC} 

000623 WTH r DO 

000624 EmptyLRect := (left >= right) OR (top >= bottom) 
000625 END; 

000626 

000627 


000628 {$S SgDRWres} 
000629 PROCEDURE AlignLRect(VAR destLRect: LRect; srcLRect: LRect; vhs: VHSelect); 
000630 BEGIN 


000631 {$I FC fMaxTrace}BP( 1); {$ENDC} 

000632 {$IFC fMaxTrace}EP; {$ENDC} 

000633 destLRect.topLeft.vh[vhs] := srcLRect.topLleft.vh[vhs] 
000634 destLRect. botRight.vh[ vhs] := srcLRect. botRi ght. vh[ vhs] 
000635 END; 

000636 

000637 


000638 {$S SgDRWres} 
000639 FUNCTION LengthLRect(r: LRect; vhs: VHSelect): LONGI NT; 
000640 BEGIN 


000641 {$I FC fMaxTrace}BP(1); {$ENDC} 

000642 {$IFC fMaxTrace}EP; {$ENDC} 

000643 LengthLRect := r.botRight.vh[vhs] - r.topLeft.vh[vhs] 
000644 END; 

000645 

000646 


000647 {$8 SgDRWres} 
000648 FUNCTION LRectsNest(outer, inner: LRect): BOOLEAN 
000649 BEGIN 


000650 {$I FC fMaxTrace}BP(1); {$ENDC} 

000651 {$IFC fMaxTrace}EP; {$ENDC} 

000652 LRectsNest := LRectHasLPt(outer, inner. topLeft) AND LRectHasLPt( outer, inner. bot Ri ght); 
000653 END; 

000654 

000655 


000656 {$S SgDRWres} 
000657 FUNCTION LRectHasLPt(destLRect: LRect; pt: LPoint): BOOLEAN 
000658 BEGIN 


000659 {$1FC fMaxTrace}BP(1); {$ENDC} 

000660 {$IFC fMaxTrace}EP; {$ENDC} 

000661 LRectHasLPt := (destLRect.left <= pt.h) AND (pt.h <= destLRect.right) AND 
000662 (destLRect.top <= pt.v) AND (pt.v <= destLRect. bottom); 
000663 END; 

000664 

000665 


000666 {$S SgDRWres} 
000667 PROCEDURE LRectHaveLPt(destLRect: LRect; VAR pt: LPoint); 


Apple Lisa ToolKit 3.0 Source Code Listing -- 525 of 1012 


Apple Lisa Computer Technical Information 


000668 BEGIN {if destLRect is negative size, left/top is forced} 


000669 {$IFC fMaxTrace}BP(1); {$ENDC} 

000670 {$1FC fMaxTrace}EP; {$ENDC} 

000671 pt.h := Max(destLRect. left, Min(destLRect.right, pt.h)) 
000672 pt.v := Max(destLRect.top, Min(destLRect. bottom, pt.v)) 
000673 END; 

000674 

000675 


000676 {$S SgDRWres} 
000677 PROCEDURE RectifyLRect(VAR destLRect: LRect); 
000678 BEGIN 


000679 {$IFC fMaxTrace}BP( 1); {$ENDC} 

000680 {$I1FC fMaxTrace}EP; {$ENDC} 

000681 SetLRect(destLRect, Min(destLRect. left, destLRect.right), Min(destLRect.top, destLRect. bottom), 
000682 Max(destLRect. left, destLRect.right), Max(destLRect.top, destLRect. bottom)); 
000683 END; 

000684 

000685 


000686 {$S SgDRWres} 
000687 FUNCTION LRectisVisible(srcLRect: LRect): BOOLEAN 


000688 VAR rectI nPort: Rect; 

000689 BEGIN 

000690 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000691 {$I1FC fMaxTrace}EP; {$ENDC} 

000692 thePad. LRectToRect(srcLRect, rectI nPort); 
000693 [F EmptyRect(rectInPort) THEN 

000694 LRectisVisible := FALSE 

000695 ELSE 

000696 LRectisVisible := RectI nRgn(rectinPort, focusRgn); 
000697 END; 

000698 

000699 


000700 {$8 SgABCdbg} 
000701 PROCEDURE LPointToStr(pt: LPoint; str: TPstring); 


000702 VAR s: $255: 

000703 BEGIN 

000704 {$IFC fMaxTrace}BP( 1); {$ENDC} 
000705 {$IFC fMaxTrace}EP; {$ENDC} 

000706 LI ntToStr(pt.h, str); 

000707 LI ntToStr(pt.v, @s) 

000708 str* := CONCAT('(', str’, ',', S, ')')} 
000709 END; 

000710 

000711 


000712 {$8 SgABCdbg} 

000713 PROCEDURE LRectToStr(r: LRect; str: TPstring); 
000714 VAR s: $255; 

000715 BEGIN 
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{$IFC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
LPointToStr(r.topLeft, str); 
LPointToStr(r.botRight, @s); 
str* := CONCAT('[', str’%, ',', §S, 
END; 
{$$ SgDRWres} 


{$$ SgDRWres} 


PROCEDURE SetLPt(VAR destPt: LPoint; itsH, itsV: 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
WTH destPt DO 
BEGIN 
h := itsH: 
vizeitsv; 
END; 
END; 
{$$ SgDRWres} 
PROCEDURE SetLRect(VAR dstRect: LRect; itsLeft, 
BEGIN 
{$IFC fMaxTrace}BP( 1); {$ENDC} 
{$1FC fMaxTrace}EP; {$ENDC} 
WTH dstRect DO 
BEGIN 
left := itsLeft; 
top := itsTop; 
right := itsRight; 
bottom := itsBottom 
END; 
END; 
{$$ SgDRWres} 
PROCEDURE OffsetLRect(VAR dstRect: LRect; dh, dv: 


BEGIN 
{$1 FC fMaxTrace}BP( 1); {$ENDC} 
{$I1FC fMaxTrace}EP; {$ENDC} 
WTH dstRect DO 


BEGIN 

left := left + dh; 
top := top + dv; 

right := right + dh; 
bottom := bottom + dv; 
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END; 
END; 
{$$ SgDRWres} 
PROCEDURE InsetLRect(VAR dstRect: LRect; dh, dv: LONGI NT); 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
WTH dstRect DO 
BEGIN 
left := left + dh; 
top := top + dv 
right := right - dh; 
bottom := bottom- dv; 
IF (left >= right) OR (top >= bottom) THEN 
BEGIN 
left := 0: 
top := 0; 
right := 0; 
bottom := 0: 
END; 
END; 
END; 
{$$ SgABCres} 
FUNCTION SectLRect(srcRectA, srcRectB: LRect; VAR dstRect: LRect): BOOLEAN; 
BEGIN 


{$IFC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
WTH dstRect DO 
BEGIN 
left := Max(srcRectA. left, srcRectB. left); 
top := Max(srcRectA.top, srcRectB. top); 
right := Min(srcRectA.right, srcRectB. right); 
bottom := Min(srcRectA. bottom, srcRectB. bottom) 
IF (left >= right) OR (top >= bottom) THEN 
BEGIN 
SectLRect := FALSE; 
left := 0: 


ELSE 
SectLRect := TRUE: 


END; 
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END; 


{$$ SgDRWres} 


PROCEDURE UnionLRect(srcRectA, srcRectB: LRect; VAR dstRect: LRect); 
BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
WTH dstRect DO 
BEGIN 
left := Min(srcRectA. left, srcRectB. left); 
top := Min(srcRectA.top, srcRectB. top); 
right := Max(srcRectA.right, srcRectB.right); 
bottom := Max(srcRectA. bottom, srcRectB. bottom) 
END; 
END; 
{$$ SgDRWres} 


FUNCTION LPtInLRect(pt: LPoint; r: LRect): BOOLEAN 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$1 FC fMaxTrace}EP: {$ENDC} 
LPtInLRect := (r.left <= pt.h) AND (pt.h < r. right) AND 
(r.top <= pt.v) AND (pt.v <r. bottom); 
END; 
{$$ SgABCdat } 


FUNCTION IsSmall Pt(srcPt: LPoint): BOOLEAN 

BEGIN 

{$IFC fMaxTrace}BP(1); {$ENDC} 

{$1FC fMaxTrace}EP; {$ENDC} 

all Pt := (ABS(srcPt.h) < MAXINT) AND (ABS(srcPt.v) < MAXINT); 


{$$ SgABCdat } 

FUNCTION IsSmall Rect(srcRect: LRect): BOOLEAN: 

BEGIN 

{$I FC fMaxTrace}BP( 1); {$ENDC} 

{$I FC fMaxTrace}EP: {$ENDC} 

all Rect := IsSmall Pt(srcRect.topLeft) AND IsSmallPt(srcRect. bot Ri ght) 


{Drawing Text} 
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PROCEDURE DrawLlText(textBuf: Ptr; startByte, numBytes: INTEGER); 


BEGIN 


{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
{$1FC libraryVersion > 20} 
IF thePad.scaled THEN 
thePad. DrawLText(textBuf, startByte, numBytes) 


ELSE 


DrawText(QDPtr(textBuf), startByte, numBytes); 


{$ELSEC} 


DrawText(WordPtr(textBuf), startByte, numBytes) 


{$ENDC} 
END; 


{Drawing lines, rectangles, and ovals} 


{$$ SgDRWres} 


PROCEDURE MoveToL(h, v: LONGI NT) 


VAR | PtI nView 
pti nPort: 
BEGIN 


LPoint; 
Point; 


{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
SetLPt(|PtInView, h, v); 
thePad, LPtToPt(| PtInView, ptIinPort); 
MoveTo(ptIinPort.h, ptinPort.v); 


END; 


{$$ SgDRWres} 


PROCEDURE MoveL(dh, dv: LONGI NT) 


VAR | PtI nView 
pti nPort: 
BEGIN 


LPoint; 
Point; 


{$1 FC fMaxTrace}BP(1); {$ENDC} 

{$IFC fMaxTrace}EP; {$ENDC} 
SetLPt(|PtInView, dh, dv); 
thePad. LDistToDist(| PtIinView, ptlnPort); 
Move(ptinPort.h, ptinPort.v); 


END; 


{$$ SgDRWres} 


PROCEDURE LineToL(h, v: LONGI NT); 


VAR | PtI nView 
BEGIN 


LPoint; 
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000908 {$I FC fMaxTrace}BP(1); {$ENDC} 
000909 {$I1FC fMaxTrace}EP; {$ENDC} 
000910 SetLPt(|PtInView, h, v); 

000911 thePad. DrawLLi ne(I Pti nView); 
000912 END; 

000913 

000914 


000915 {$8 SgDRWres} 
000916 PROCEDURE LineL(dh, dv: LONGI NT); 
000917 VAR I PtInView: LPoint 


000918 pti nPort: Point; 

000919 BEGIN 

000920 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000921 {$IFC fMaxTrace}EP; {$ENDC} 

000922 SetLPt(|PtInView, dh, dv) 

000923 thePad. LDistToDist(|PtIinView, ptlnPort); 
000924 Line(ptinPort.h, ptinPort.v) 

000925 END: 

000926 

000927 


000928 {$8 SgDRWres} 
000929 PROCEDURE FrameLRect(r: LRect); 
000930 BEGIN 


000931 {$1 FC fMaxTrace}BP(1); {$ENDC} 
000932 {$1FC fMaxTrace}EP; {$ENDC} 
000933 thePad. DrawLRect(frame, r); 
000934 END; 

000935 

000936 


000937 {$8 SgDRWres} 
000938 PROCEDURE PaintLRect(r: LRect); 
000939 BEGIN 


000940 {$1 FC fMaxTrace}BP(1); {$ENDC} 
000941 {$IFC fMaxTrace}EP; {$ENDC} 
000942 thePad. DrawLRect(paint, r); 
000943 END; 

000944 

000945 


000946 {$S SgDRWres} 
000947 PROCEDURE EraseLRect(r: LRect); 
000948 BEGIN 


000949 {$1 FC fMaxTrace}BP(1); {$ENDC} 
000950 {$IFC fMaxTrace}EP; {$ENDC} 
000951 thePad. DrawLRect(erase, r); 
000952 END; 

000953 

000954 


000955 {$8 SgDRWres} 
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000956 PROCEDURE InvrtLRect(r: LRect); 
000957 BEGIN 


000958 {$I FC fMaxTrace}BP(1); {$ENDC} 
000959 {$IFC fMaxTrace}EP; {$ENDC} 
000960 thePad. DrawLRect(invert, r); 
000961 END; 

000962 

000963 


000964 {$8 SgDRWres} 
000965 PROCEDURE FillLRect(r: LRect; | Pat: LPattern); 


000966 VAR pat: Pattern; 

000967 BEGIN 

000968 {$1 FC fMaxTrace}BP(1); {$ENDC} 
000969 {$IFC fMaxTrace}EP; {$ENDC} 
000970 [F amPrinting THEN 

000971 thePad, LPatToPat(| Pat, pat) 
000972 {$IFC LibraryVersion <= 20} 

000973 thePat := Pattern(| Pat) 

000974 {$ELSEC} 

000975 thePort*. fill Pat := Pattern(I| Pat); 
000976 {$ENDC} 

000977 thePad. DrawLRect(fill, r); 
000978 END; 

000979 

000980 


000981 {$8 SgDRWres} 
000982 PROCEDURE FrameLOval(r: LRect); 
000983 BEGIN 


000984 {$1 FC fMaxTrace}BP(1); {$ENDC} 
000985 {$IFC fMaxTrace}EP; {$ENDC} 
000986 thePad. DrawLOval(frame, r); 
000987 END; 

000988 

000989 


000990 {$8 SgDRWres} 
000991 PROCEDURE PaintLOval(r: LRect); 
000992 BEGIN 


000993 {$I FC fMaxTrace}BP(1); {$ENDC} 
000994 {$IFC fMaxTrace}EP; {$ENDC} 
000995 thePad. DrawLOval (paint, r); 
000996 END; 

000997 

000998 


000999 {$S SgDRWres} 

001000 PROCEDURE EraseLOval(r: LRect); 
001001 BEGIN 

001002 {$1 FC fMaxTrace}BP(1); {$ENDC} 
001003 {$IFC fMaxTrace}EP; {$ENDC} 
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thePad. DrawLOval (erase, r); 
END; 


{$$ SgDRWres} 
PROCEDURE InvrtLOval(r: LRect); 
BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
thePad. DrawLOval (invert, r); 
END; 


{$$ SgDRWres} 
PROCEDURE FillLOval(r: LRect; | Pat: LPattern); 
VAR pat: Pattern; 
BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
1F amPrinting THEN 
thePad, LPatToPat(| Pat, pat); 
{$1FC LibraryVersion <= 20} 


thePat := Pattern(I Pat); 
{$ELSEC} 

thePort*. fill Pat := Pattern(I Pat); 
{$ENDC} 

thePad. DrawLOval (fill, r); 


END; 


PROCEDURE FrameLRRect(r: LRect; oval Width, oval Height: INTEGER); 
BEGIN 
{$IFC fMaxTrace}BP(1); {$ENDC} 
{$I FC fMaxTrace}EP: {$ENDC} 
thePad. DrawLRRect(frame, r, oval Width, oval Hei ght); 
END; 


PROCEDURE PaintLRRect(r: LRect; oval Width, oval Height: INTEGER); 
BEGIN 
{$I FC fMaxTrace}BP( 1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
thePad. DrawLRRect(paint, r, oval Width, oval Hei ght); 
END; 


PROCEDURE EraseLRRect(r: LRect; oval Width, oval Height: INTEGER); 
BEGIN 
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{$I FC fMaxTrace}BP(1); {$ENDC} 
{$I FC fMaxTrace}EP: {$ENDC} 
thePad. DrawLRRect(erase, r, oval Width, oval Hei ght); 
END; 


PROCEDURE InvrtLRRect(r: LRect; oval Width, oval Height: INTEGER); 


BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
thePad. DrawLRRect(invert, r, oval Width, oval Height); 
END; 


PROCEDURE FillLRRect(r: LRect; ovalWdth, ovalHeight: INTEGER 


VAR pat: Pattern; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
1F amPrinting THEN 
thePad, LPatToPat(| Pat, pat); 
{$1 FC LibraryVersion <= 20} 


thePat := Pattern(I Pat); 
{$ELSEC} 
thePort*. fill Pat := Pattern(I| Pat); 
{$ENDC} 
thePad. DrawLRRect(fill, r, oval Width, oval Hei ght) 


END; 


PROCEDURE FrameLArc(r: LRect; startAngle, arcAngle: | NTEGER) 
BEGIN 
{$I FC fMaxTrace}BP( 1); {$ENDC} 
{$I FC fMaxTrace}EP: {$ENDC} 
thePad. DrawLArc(frame, r, startAngle, arcAngle); 
END; 


PROCEDURE PaintLArc(r: LRect; startAngle, arcAngle: | NTEGER) 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
thePad. DrawLArc(paint, r, startAngle, arcAngle); 
END; 


PROCEDURE EraseLArc(r: LRect; startAngle, arcAngle: I NTEGER) 
BEGIN 


LPattern); 
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001100 {$IFC fMaxTrace}BP(1); {$ENDC} 

001101 {$IFC fMaxTrace}EP; {$ENDC} 

001102 thePad. DrawLArc(erase, r, startAngle, arcAngle); 
001103 END; 

001104 

001105 


001106 PROCEDURE InvrtLArc(r: LRect; startAngle, arcAngle: INTEGER); 
001107 BEGIN 


001108 {$I FC fMaxTrace}BP(1); {$ENDC} 

001109 {$I1FC fMaxTrace}EP; {$ENDC} 

001110 thePad. DrawlLArc(invert, r, startAngle, arcAngle); 
001111 END; 

001112 

001113 

001114 PROCEDURE FillLArc(r: LRect; startAngle, arcAngle: INTEGER; | Pat: LPattern); 
001115 VAR pat: Pattern; 

001116 BEGIN 

001117 {$1FC fMaxTrace}BP(1); {$ENDC} 

001118 {$IFC fMaxTrace}EP; {$ENDC} 

001119 1F amPrinting THEN 

001120 thePad, LPatToPat(| Pat, pat) 

001121 {$IFC LibraryVersion <= 20} 

001122 thePat := Pattern(| Pat) 

001123 {$ELSEC} 

001124 thePort*. fill Pat := Pattern(I| Pat); 

001125 {$ENDC} 

001126 thePad. DrawLArc(fill, r, startAngle, arcAngl e) 
001127 END; 

001128 

001129 

001130 PROCEDURE RotatePattern(plnPat, pOutPat: Ptr; dh, dv: LONGI NT) 
001131 EXTERNAL; 

001132 

001133 


001134 {$8 SgABCdat } 
001135 FUNCTION ClonePicture(pic: PicHandle; toHeap: THeap): PicHandle; 


001136 VAR h: TH 

001137 BEGIN 

001138 {$I FC fMaxTrace}BP(1); {$ENDC} 

001139 {$1FC fMaxTrace}EP; {$ENDC} 

001140 h := HAllocate(THz(toHeap), pic**. picSize); 
001141 XferLeft(Ptr(pic*), Ptr(h*), pic**. picSize) 
001142 ClonePicture := PicHandl e(h) 


001143 END; 

001144 {$8 SgDRWres} 

001145 

001146 

001147 PROCEDURE ResizeFeedback( mousePt: Point; minPt, maxPt: Point; outerRect: Rect; 
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001148 tabHeight, sbWdth, sbHeight: INTEGER; VAR newPt: Point); 
001149 

001150 VAR rFrame: Rect; 

001151 limitRect: Rect; 

001152 ol dMousePt: Point; 

001153 innerTop: INTEGER; 

001154 f Tab: BOOLEAN; 

001155 fHscroll: BOOLEAN; 

001156 fVScroll: BOOLEAN; 

001157 event: Event Record; 

001158 savePort: Graf Ptr; 

001159 

001160 PROCEDURE I nit XorFrame; 

001161 BEGIN 

001162 fTab := TRUE: 

001163 fHScroll := TRUE; 

001164 fVScroll := TRUE; 

001165 

001166 { set up scroll bar and tab widths } 
001167 { the +1 's are to account for enlarging rFrame by one pixel } 
001168 IF sbWidth > 0 THEN 

001169 sbWidth := sbWdth+1 

001170 ELSE 

001171 fVScroll := FALSE: 

001172 

001173 IF sbHeight > 0 THEN 

001174 sbHeight := sbHeight+1 

001175 ELSE 

001176 fHScroll := FALSE: 

001177 

001178 1F tabHeight > 0 THEN 

001179 tabHei ght := tabHeight+1 

001180 ELSE 

001181 fTab : = FALSE: 

001182 

001183 { setup rFrame - the outer rect for XORing } 
001184 rFrame := outerRect; 

001185 InsetRect(rFrame, -1, -1); 

001186 

001187 limitRect.topLeft := minPt; 

001188 limitRect. botRight := maxPt; 

001189 

001190 |F fTab THEN innerTop := rFrame.top+tabHei ght 
001191 ELSE innerTop := rFrame. top; 

001192 

001193 { Setup the pen } 

001194 PenNor mal ; 

001195 PenPat (gray); 
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PenMode(notPatXor); 
END; 


PROCEDURE XorFrame; 
BEGIN 
rFrame. bot Right := 
FrameRect(rFrame); 
1F fTab THEN 
BEGIN 
MoveTo(rFrame. left, 
Li neTo(rFrame, ri ght- 
END; 
1F fHScroll THEN 
BEGIN 
MoveTo(rFrame. left, 
Li neTo(rFrame. right- 
END; 
IF fVScroll THEN 
BEGIN 


MoveTo(newPt.h - sbWidth, 
LineTo(newPt.h - sbWidth, 


END; 
END; 


PROCEDURE DoDragFrame; 


VAR nxt Pt: Point; 
BEGIN 
nxtPt := Point(FPtPlusPt(newPt, 
RectHavePt(limitRect, 
mousePt := 


1F NOT Equal Pt(nxtPt, 
B 


newPt; 


innerTop); 
1, inmnerTop); 


newPt. v-sbHei ght); 
1, newPt, v-sbHei ght); 


innerTop); 
rFrame. bottom 1); 


Poi nt(FPt Mi nusPt(mousePt, 


nxt Pt); 
Point(FPtPl usPt( Poi nt(FPt Mi nusPt(nxtPt, 


newPt)), 


newPt) THEN 


EGIN 
XorFrame; { hide old } 
newPt := nxtPt; 
XorFrame; { draw new } 
END; 
END; 
BEGIN 


{$I FC fMaxTrace}BP( 1); {$ENDC} 
{$I FC fMaxTrace}EP: {$ENDC} 


Init XorFrame; 


newPt := 
XorFrame; 


rFrame. bot Ri ght; 
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ol dMousePt)); 


537 of 


1012 


001244 
001245 
001246 
001247 
001248 
001249 
001250 
001251 
001252 
001253 
001254 
001255 
001256 
001257 
001258 
001259 
001260 
001261 
001262 
001263 
001264 
001265 
001266 
001267 
001268 
001269 
001270 
001271 
001272 
001273 
001274 
001275 
001276 
001277 
001278 
001279 
001280 
001281 
001282 
001283 
001284 
001285 
001286 
001287 
001288 
001289 
001290 
001291 
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oldMousePt := mousePt; 
WHILE Still Down DO 
BEGIN 
Get Mouse( mousePt); 
DoDragFrame; 
ol dMousePt := 
END; 


mousePt; 


IF PeekEvent(event) AND (event. what = buttonUp) THEN 
BEGIN 
GetPort(savePort); 
SetPort(event. who); 
mousePt := event. where 
Local ToGl obal ( mousePt ) 
SetPort(savePort); 

Gl obal ToLocal (mousePt); 
END 

ELSE 

Get Mouse( mousePt); 


DoDragFrame; 


XorFrame; 
newPt.h := newPt.h - 1; 
newPt.v := newPt.v - 1; 
{ ResizeFeedback } 


{ hide last } 


SgABCres} 


PROCEDURE PopFocus; 


BEGI 


END; 


{$$ 


N 
{$1 FC fTrace}BP( 6); {$ENDC} 
SetEmptyRgn(padRgn); {To save memory space} 
focusArea := focusStack[focusStkPtr] 
thePad := NIL; 
IF focusArea <> NIL THEN 
focusArea. Focus 
focusStkPtr := focusStkPtr - 1; 
{$1 FC fTrace}EP; {$ENDC} 


SgABCres} 


PROCEDURE PushFocus; 


BEGI 


N 

{$1 FC fTrace}BP( 6); {$ENDC} 
focusStkPtr := focusStkPtr + 1; 
focusStack[focusStkPtr] := focusArea; 
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{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ SgDRWres} 


PROCEDURE MakeTypeStyle{(itsFamily: INTEGER; itsSize: INTEGER; itsFaces: TSetEFace/ Style 


VAR typeStyle: TTypeStyle) }; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
WTH typeStyle DO 
BEGIN 
onFaces := itsFaces 
font. fontFamily := itsFamily; 
font. fontSize := itsSize 


END; 
{$I FC fTrace}EP; {$ENDC} 
END; 


FUNCTION QDFontNumber{(typeStyle: TTypeStyle): INTEGER}; 
BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
WTH typeStyle.font DO 
[F fontFamily = famSystem THEN 
QDFontNumber := fl DSystem 
ELSE 
QDFontNumber := fontID[fontFamily, fontSize] 
{$1 FC fTrace}EP; {$ENDC} 


PROCEDURE Set QDTypeStyle{(typeStyle: TTypeStyle)}; 
BEGIN 

{$1 FC fTrace}BP(11); {$ENDC} 

Text Font (QDFont Number(typeStyle) ) 

Text Face(typeStyle. onFaces); 

{$I FC fTrace}EP; {$ENDC} 
END; 


METHODS OF TArea:; 


{$1 FC fDebugMet hods} 
{$8 SgABCdbg} 
PROCEDURE TArea. Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
Field('innerRect: Rect'); 
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Field('outerRect: Rect'); 
Field('parentBranch: TBranchArea' ); 
END; 
{$S SgDRWres} 
{$ENDC} 


FUNCTION TArea. ChildWithPt(pt: Point; childList: TList; VAR nearestPt: Point) 


VAR foundArea: TArea; 
S! TListScanner 
BEGIN 
{$1FC fTrace}BP(6); {$ENDC} 
Rect HavePt(SELF.innerRect, pt); 
s := childList. scanner 
WHILE s.Scan(foundArea) DO 
IF RectHasPt(foundArea. outerRect, pt) THEN 
s. Done; 
1F foundArea = NIL THEN 
BEGIN 
{$1 FC fDbgDraw} 
ABCbreak('ChildWthPt found no area’, 0) 


{$ENDC} 
foundArea := TArea(childList. First); 
END; 
Rect HavePt(foundArea.innerRect, pt); 
nearestPt := pt; 


ChildWithPt := foundArea; 
{$SIFC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TArea. Erase 

BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
Fill Rect(SELF.innerRect, white); 
{$IFC fTrace}EP; {$ENDC} 

END; 


PROCEDURE TArea. Frame 


VAR innerRect: Rect; 

borderRect: Rect; 
BEGIN 

{$1FC fTrace}BP( 6); {$ENDC} 

innerRect := SELF.innerRect; 

IF NOT RectsNest(innerRect, focusRgn**.rgnBBox) THEN 
BEGIN 
PenNor mal 


TArea; 
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PenSize(1, 1); 
borderRect := innerRect; 
InsetRect(borderRect, -1, -1); 
FrameRect(borderRect); 
END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TArea. Get Border(VAR border: Rect); 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
SetRect(border, -1, -1, 1, 1); 
{$1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TArea. Seti nnerRect(newlnnerRect: Rect); 
VAR border: Rect; 


BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
SELF.innerRect := newlnnerRect; 


SELF. Get Border( border); 
{$H-} RectPlusRect(SELF.innerRect, border, SELF.outerRect); {$H+} 
{$1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TArea. SetOuterRect(newOuterRect: Rect); 
VAR border: Rect; 


BEGIN 
{$I FC fTrace}BP(7); {$ENDC} 
SELF.outerRect := newOuterRect; 


SELF. Get Border( border); 
{$H-} Rect MinusRect(SELF.outerRect, border, SELF.innerRect); {$H+} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCi ni} 
BEGIN 


font! D[ famModern, size20Pitch] : 
font! D[ famModern, sizel5Pitch] : 
font! D[ famModern, sizelOPitch] : 
font! D[famModern, sizel2Pitch] : 
font! D[ famModern, sizel2Point] : 
font! D[ famModern, sizel4Point] : 
font! D[ famModern, sizel8Point] : 


fl D20Pitch; 
fl DI5Pitch; 
fl Dml0Pitch; 
fl Dmi2Pitch; 
f 1 Dmi2Poi nt; 
f 1 Dmi4Poi nt; 
f | Dmi8Poi nt; 
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fontID[ famModern, size24Point] := fl Dm24Point; 


font! D[famClassic, size20Pitch] 
font D[ famClassic, sizel5Pitch] 
font D[famClassic, sizel0Pitch] 
fontID[ famClassic, sizel2Pitch] 
fontID[famClassic, sizel2Point] : 
font D[famClassic, sizel4Point] : 
font D[famClassic, sizel8Point] : 
font! D[famClassic, size24Point] : 


f1 D20Pitch; 

fl DI5Pitch; 

fl Dcl0Pitch: 
fl Dcl2Pitch: 
f1Dc12Poi nt; 
fl Dc1l4Poi nt; 
f 1 Dc18Poi nt; 
f1Dc24Poi nt; 


MakeTypeStyle(famSystem, 0 {dummy}, [], sysTypeStyle) 
SgDRWres } 


METHODS OF TPad 


{$S sCldl nit} 


FUNCTION TPad.CREATE(object: TObject; heap: THeap; itsInnerRect: Rect; itsViewedLRect: 


itsPadRes, itsViewRes: Point 
itsPort: GrafPtr): TPad; 
VAR zoomFactor: TScaler 
BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TPad(obj ect); 
SELF. parent Branch := NIL; 
SetPt(zoomFactor. numerator, 1, 1) 
SetPt(zoomFactor. denominator, 1, 1); 
SELF. Redefine(itsinnerRect, itsViewedLRect, itsPadRes, itsViewRes 
zoomFactor, itsPort); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$S SgDRWres} 


{$$ sCldl nit} 
PROCEDURE TPad. Redefine(itsinnerRect: Rect; itsViewedLRect: LRect 
itsPadRes, itsViewRes: Point; 
itsZoomFactor: TScaler; itsPort: GrafPtr); 
VAR vhs: VHSel ect; 
newOffset: LPoint; 
BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 
SELF. Seti nnerRect(itsl nnerRect); 
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WITH SELF, scaleFactor DO 

{$H-} BEGIN 
port := itsPort; 
viewedLRect := itsViewedLRect; 
avail LRect := itsViewedLRect 
InsetLRect(availLRect, -8192, -8192) 
clippedRect := itsInnerRect; 
zoomFactor := itsZoomFactor 


{install new Resol uti ons} 
padRes := itsPadRes 
viewedRes := itsViewRes 


{compute scale factor fromresolutions and zoom factor} 
FOR vhs := v TO h DO 
BEGIN 


numerator. vh[ vhs] := itsPadRes.vh[vhs] * zoomFactor. numerator. vh[vhs] 
denominator. vh[ vhs] := itsViewRes.vh[ vhs] * zoomFactor. denominator. vh[ vhs] 


Reduce(numerator.vh[ vhs], denominator. vh[vhs]); 
END; 


scaled 
{compute scroll offset} 


FOR vhs := v TO h DO 
newOffset.vh[vhs] := 


Lint Ovrint(Lint Mull nt(itsViewedLRect.topLeft.vh[ vhs] 


numerator. vh[vhs]), 
denominator.vh[vhs]) - 


SELF. SetScroll Offset (newOffset); 
{$H+} END; 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgDRWres} 


{$1 FC fDebugMet hods} 
{$8 SgABCdbg} 
PROCEDURE TPad. Fields( PROCEDURE Field(nameAndType: $255) ) 
BEGIN 
TArea. Fields( Field); 
Field('port: Ptr'); 
Field('viewedLRect: LRect'); 
Field('visLRect: LRect'); 
Field('availLRect: LRect'); 
Field('scroll Offset: LPoint'); 


:= (numerator.h <> denominator. h) OR (numerator.v <> denominator. v) 


itslnnerRect.topLeft. vh[vhs] 
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Field('origin: Point'); {+LSR+} 
Field('cdOffset: LPoint'); {+LSRt+} 
Field('clippedRect: rect'); 
Field('padRes: Point') 
Field('viewedRes: Point'); 
Field('scaled: BOOLEAN' ) 
Field('scaleFactor: RECORD numerator: Point; denominator: Point END') 
Field('zoomFactor: RECORD numerator: Point; denominator: Point END'); 
END; 
{$S SgDRWres} 
{$ENDC} 


PROCEDURE TPad. ClipFurtherTo(rBand: rect); {narrows down clip area at next Focus} 
VAR grafRect: Rect; 

BEGIN 
{$I1FC fTrace}BP(7); {$ENDC} 

{$H-} IF SectRect(rBand, SELF.clippedRect, SELF.clippedRect) THEN; {$H+} 
{$1FC fTrace}EP; {$ENDC} 

END; 


PROCEDURE TPad. DistToLDist(distI nPort: Point; VAR I DistInView: LPoint); 
BEGIN 
{$1FC fTrace}BP(6); {$ENDC} 
I1F SELF.scaled THEN 
WITH SELF.scaleFactor DO 
{$H- } BEGIN 
IDistInView.h : 
I DistInViewv 
{$H+} END 
ELSE 
BEGIN 
IDistInView.h : 
I DistIinView.v 
END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


LintOvrint(Lint Mull nt(distinPort.h, denominator.h), numerator. h) 
LintOvrint(Lint Mull nt(distinPort.v, denominator.v), numerator. v) 


distinPort.h; 
distinPort.v; 


PROCEDURE TPad. DrawLLine(newLPt: LPoi nt); 
VAR newGraf Pt: Point; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
SELF. LPtToPt(newLPt, newGraf Pt); 
StdLine(newGraf Pt); 
END; 
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001581 

001582 {$lFC LibraryVersion <= 20} 

001583 {This is still not the right implementation when we are printing} 


001584 PROCEDURE TPad. DrawLPicture(pic: PicHandle; r:LRect); 
001585 VAR rectI nPort: Rect; 

001586 BEGIN 

001587 SELF. LRectToRect(r, rectInPort); 

001588 DrawPicture(pic, rectI nPort); 

001589 END; 

001590 {$ELSEC} 

001591 PROCEDURE TKStdText(byteCount: INTEGER; textBuf: QDPtr; numer, denom: Point) 
001592 BEGIN 

001593 StdText(byteCount, textBuf, numer, numer); 

001594 END; 

001595 

001596 PROCEDURE TKStdComment(kind, datasize: INTEGER; dataHandle: QDHandle); 
001597 CONST 

001598 picForeCol or = 108; 

001599 pi cBackCol or = 109; 

001600 

001601 VAR pData: TpLongi nt; 

001602 

001603 BEGIN 

001604 IF dataHandle <> NIL THEN 

001605 IF dataSize <> 4 THEN 

001606 BEGIN 

001607 pData := TpLongi nt(ORD( dataHandl e*)); 
001608 

001609 CASE kind OF 

001610 picForeCol or: 

001611 ForeCol or(pData%*) 

001612 picBackCol or: 

001613 BackCol or( pData%*) 

001614 END; 

001615 END; 

001616 END; 

001617 

001618 {This is still not the right implementation when we are printing} 
001619 PROCEDURE TPad. DrawLPicture(pic: PicHandle; r:LRect); 
001620 VAR rectI nPort: Rect; 

001621 ol dProcsPtr: QDProcsPtr 

001622 TKProcs: QDProcs; 

001623 ol dText Proc: QDPtr: 

001624 ol dCommentProc: QDPtr 

001625 BEGIN 

001626 {$1 FC fMaxTrace}BP(1); {$ENDC} 

001627 {$IFC fMaxTrace}EP; {$ENDC} 
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WITH thePort* DO 
BEGIN 
oldProcsPtr := 
IF oldProcsPtr 
BEGIN 
Set StdProcs(TKProcs); 
grafprocs := @TKProcs; 
END; 

WITH grafprocs* DO 
BEGIN 


f procs; 


gra 
= NIL THEN 


oldTextProc := textProc 

ol dComment Proc := comment Proc 

1F amPrinting THEN 
BEGIN 
textProc := @TKStdText; 
comment Proc := @TKStdComment; 
END: 

END; 

END; 


SELF. LRectToRect(r, rectInPort); 
DrawPicture(pic, rectI nPort); 


WITH thePort* DO 
BEGIN 
IF oldProcsPtr <> NIL THEN 
WITH grafprocs* DO 


BEGIN 
textProcs := oldTextProc 
comment Proc := ol dComment Proc 
END; 
grafProcs := oldProcsPtr 
END; 
END; 
{$ENDC} 


PROCEDURE TPad. DrawLRect(verb: GrafVerb; r: LRect); 
VAR rectI nPort: Rect; 
BEGIN 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
SELF. LRectToRect(r, rectinPort); 
StdRect(verb, rectinPort); 
END; 


PROCEDURE TPad. DrawLRRect(verb: GrafVerb; r: LRect; oval Width, oval Height: INTEGER); 
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VAR rectI nPort: Rect; 
BEGIN 

{$IFC fMaxTrace}BP(1); {$ENDC} 

{$IFC fMaxTrace}EP; {$ENDC} 

SELF.LRectToRect(r, rectinPort); 

StdRRect(verb, rectinPort, oval Wdth, oval Hei ght); 
END: 


PROCEDURE TPad. DrawLOval(verb: GrafVerb; r: LRect); 
VAR rectInPort: Rect; 
BEGIN 
{$IFC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
SELF. LRectToRect(r, rectInPort); 
StdOval(verb, recti nPort); 
END: 


PROCEDURE TPad. DrawLArc(verb: GrafVerb; r: LRect; startAngle, arcAngle: INTEGER) 
VAR rectI nPort: Rect; 
BEGIN 
{$IFC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
SELF. LRectToRect(r, rectInPort); 
StdArc(verb, rectInPort, startAngle, arcAngle); 
END; 


PROCEDURE TPad. DrawLBits(VAR srcBits: BitMap; VAR srcRect: Rect; 
VAR dstLRect: LRect; mode: INTEGER; maskRgn: RgnHandle); 

VAR dstGrafRect: Rect; 
BEGIN 

{$IFC fMaxTrace}BP(1); {$ENDC} 

{$IFC fMaxTrace}EP; {$ENDC} 

SELF. LRectToRect(dstLRect, dstGrafRect); 

StdBits(srcBits, srcRect,dstGrafRect, mode, maskRgn); 
END; 


SgABCres} 
PROCEDURE TPad. Focus 
VAR visRgn: RgnHandle; 
origin: Point; 
BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
IF SELF.Port <> printerPseudoPort THEN 
SetPort(SELF. port); {for the moment anyway don't tamper if being controlled 


by LisaPrint} 
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SetOrigin(0, 0); {so thePort*.visRgn will be relative to a (0,0)-origined space, to match 


SELF.clippedRect and altVisRgn} 
Rect Rgn(padRgn, SELF.clippedRect); 


IF useAltVisRgn THEN 


visRgn := altVisRgn {I nstigated by TWindow. StashPicture or TClipboard. Publicize} 


ELSE 
visRgn := thePort*. visRgn; 


SectRgn(padRgn, visRgn, padRgn); 


origin := SELF. origin; 

WITH origin DO {+LSR+} 
BEGIN 
SetOrigin(h, v); 
OffsetRgn(padRgn, h, v); 


Set Clip(padRgn) 


focusRgn := padRgn; {focusRgn is an alias for either padRgn or visRgn} 


focusArea := SELF: 
thePad := SELF; 


WITH SELF DO 
{$H- } BEGIN 
SELF. Rect ToLRect(focusRgn**.rgnBBox, visLRect); 
IF SectLRect(viewedLRect, visLRect, visLRect) THEN 
BEGIN END; 
{$H+} END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TPad. I nvalLRect(r: LRect); 
VAR rectI nPort: Rect; 

BEGIN 
{$IFC fTrace}BP(7); {$ENDC} 
SELF.LRectToRect(r, rectinPort); 
SELF. I nval Rect(rectInPort); 
{$1FC fTrace}EP; {$ENDC} 

END: 


PROCEDURE TPad.Inval Rect(r: Rect); 
BEGIN 


Apple Lisa ToolKit 3.0 Source Code Listing 


548 of 1012 


001772 
001773 
001774 
001775 
001776 
001777 
001778 
001779 
001780 
001781 
001782 
001783 
001784 
001785 
001786 
001787 
001788 
001789 
001790 
001791 
001792 
001793 
001794 
001795 
001796 
001797 
001798 
001799 
001800 
001801 
001802 
001803 
001804 
001805 
001806 
001807 
001808 
001809 
001810 
001811 
001812 
001813 
001814 
001815 
001816 
001817 
001818 
001819 


Apple Lisa Computer Technical Information 


{$I1FC fTrace}BP(7); {$ENDC} 
IF SectRect(r, focusRgn**.rgnBBox, r) THEN 
Inval Rect(r); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$$ SgDRWres} 


PROCEDURE TPad. LDistToDist(| DistIinView: LPoint;: VAR distI nPort: Point); 
BEGIN 
{$I FC fTrace}BP(6); {$ENDC} 
IF SELF.scaled THEN 
WITH SELF.scaleFactor DO 


{$H- } BEGIN 
distinPort.h := LintOvrint(LIi nt Mull nt(IDistInView.h, numerator.h), denominator. h) 
distinPort.v := LintOvrint(LIi nt Mull nt(IDistI nView.v, numerator.v), denominator. v) 
{$H+} END 
ELSE 
BEGIN 
distI nPort.h := | DistInView.h; 
distI nPort.v := I DistInView.v; 
END; 


{$IFC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TPad. LPatToPat(|PatIinView: LPattern; VAR patinPort: Pattern) 
BEGIN 
{$IFC fTrace}BP( 6); {$ENDC} 
1F amPrinting THEN 
RotatePattern(@PatInView, @patinPort, SELF.cdOffset.h, SELF. cdOffset.v) 
ELSE 
patinPort := Pattern(|PatIinView); {+LSR+} 
{$IFC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TPad. LPtToPt(IPtInView: LPoint; VAR ptInPort: Point); 
BEGIN 
{$I FC fTrace}BP(6); {$ENDC} 
LRectHaveLPt(SELF.availLRect, | Pt! nVi ew) 
WITH SELF, cdOffset, scaleFactor DO {+LSRt+} 
I1F scaled THEN 


{$H- } BEGIN 
pti nPort.h := LintOvrint(Lint Mull nt(]PtinView.h, numerator.h), denominator.h) - 
pti nPort.v := LintOvrint(Lint Mull nt(]PtinView.v, numerator.v), denominator.v) - 
{$H+} END 
ELSE 
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1PtinView.h - h: 
1PtinView.v - v3 


BEGIN 
ptinPort.h : 
pti nPort.v : 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
SgABCres} 


PROCEDURE TPad. LRect ToRect(l RectIi nView 


BEGIN 
{$1FC fTrace}BP(6); 


LRectHaveLPt( SELF. avail LRect, 
LRectHaveLPt( SELF. avail LRect, 


LRect; VAR rectIl nPort: Rect); 
{$ENDC} 
|RectinView. topLeft); 


| RectI nVi ew. bot Ri ght); 


WITH SELF, cdOffset, scaleFactor DO {+LSR+} 
1F scaled THEN 
{$H-} BEGIN 
rectIinPort. left := LintOvrint(LIi nt Mull nt(I]RectinView. left, numerator. h), denominator. h) - h; 
rectInPort.top := LintOvrint(Lint Mull nt(IlRectI nView. top, numerator.v), denominator.v) - v; 
rectInPort. right := LintOvrint(LintMull nt(I]RectinView. right, numerator.h), denominator.h) - h; 
recti nPort. bottom:= LintOvrint(Li nt Mull nt(|RectIi nView. bottom, numerator.v), denominator. v) 
_ Vv 
{$H+} END 
ELSE 
BEGIN 
rectIinPort. left := |RectinView.left - h; 
rectinPort.top := |RectIinView.top - v; 
rectinPort.right := |RectIinView. right - h; 
rectI nPort. bottom:= |RectI nView. bottom - v; 


END; 
{$I1FC fTrace}EP; {$ENDC} 


END; 
SgDRWres } 


PROCEDURE TPad. Offset By(deltaLPt: 
VHSel ect; 
LPoint; 


VAR vhs: 
newOffset: 
BEGIN 
{$I FC fTrace}BP(7); 
WITH SELF, 
{$H- } BEGIN 


Of fsetLRect(viewedLRect, 
OffsetLRect(availLRect, h, 


{$H+} END; 


FOR vhs := 
WITH SELF, scal 
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LPoint); 


{$ENDC} 


deltaLPt DO 


h, v); 
Vv); 


v TO h DO {$H-} {+LSR+} 


eFactor DO 
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001868 newOffset.vh[ vhs] := Lil ntOvrint(Li nt Mull nt(viewedLRect.topLeft.vh[ vhs] 
001869 numerator. vh[vhs]), 
001870 denominator.vh[vhs]) - innerRect.topLeft. vh[ vhs] 
001871 {$H+} 

001872 SELF. SetScrollOffset(newOffset); 

001873 {$1FC fTrace}EP; {$ENDC} 

001874 END; 

001875 

001876 

001877 PROCEDURE TPad. PatToLPat(patIinPort: Pattern; VAR | Pati nView: LPattern); 

001878 BEGIN 

001879 {SI FC fTrace}BP( 6); {$ENDC} 

001880 1F amPrinting THEN 

001881 RotatePattern(@patinPort, @lPatInView, -SELF.cdOffset.h, -SELF.cdOffset.v) 
001882 ELSE 

001883 LPatInView := LPattern(patInPort); {+LSR+} 

001884 {$I1FC fTrace}EP; {$ENDC} 

001885 END; 

001886 

001887 

001888 PROCEDURE TPad. PtToLPt(ptinPort: Point; VAR | PtInView: LPoint); 

001889 {$1 FC fDbgDraw} 

001890 VAR pt: Point; 

001891 s: $255; 

001892 {$ENDC} 

001893 BEGIN 

001894 {$I1FC fTrace}BP( 6); {$ENDC} 

001895 WITH SELF, cdOffset, scaleFactor DO {+LSR+} 

001896 IF scaled THEN 

001897 {$H- } BEGIN 

001898 PPtinViewwh := LintOvrint(LintMull nt(ptinPort.h + h, denominator.h), numerator. h) 
001899 PPtinView.v := LintOvrint(LintMull nt(ptinPort.v + v, denominator.v), numerator. v) 
001900 {$H+} END 

001901 ELSE 

001902 BEGIN 

001903 1PtinView.h := pti nPort.h + h; 


001904 1PtinView.v := pti nPort.v + v; 
001905 END; 

001906 {$1 FC fDbgDraw} 

001907 SELF. LPtToPt(|PtinView, pt) 
001908 1F NOT Equal Pt( pt, ptIlnPort) THEN 
001909 BEGIN 

001910 PointToStr(ptinPort, @s); 
001911 writeln('ptIlnPort:', s); 
001912 LPointToStr(|PtInView, @s) 
001913 writel n('|PtlnView:',s) 
001914 PointToStr(pt, @s); 

001915 writeln('pt:', s); 
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001916 Wr Obj (SELF, 1, ''); 

001917 writeln; 

001918 ABCbreak('Error in TPad. PtToLPt', 0) 

001919 END; 

001920 {$ENDC} 

001921 {$I1FC fTrace}EP; {$ENDC} 

001922 END; 

001923 

001924 

001925 {$8 SgABCres} 

001926 PROCEDURE TPad. RectToLRect(rectInPort: Rect; VAR | RectinView: LRect); 
001927 BEGIN 

001928 {$I1FC fTrace}BP( 6); {$ENDC} 

001929 WITH SELF, cdOffset, scaleFactor DO {+LSR+} 

001930 IF scaled THEN 

001931 {$H- } BEGIN 

001932 |RectInView.left := 

001933 LintOvrint(Lint Mull nt(rectinPort. left + h, denominator.h), numerator. h) 
001934 |RectIinView.top := 

001935 Lint Ovrint( Lint Mull nt(rectInPort.top + v, denominator.v), numerator. v) 
001936 [RectIinView. right := 

001937 Lint Ovrint(Lint Mull nt(rectIi nPort. right + h, denominator. h), numerator. h) 
001938 |RectIinView. bottom: = 

001939 LintOvrint(Lint Mull nt(rectIi nPort. bottom + v, denominator.v), numerator.v); 
001940 {$H+} END 

001941 ELSE 

001942 BEGIN 

001943 |RectIinView.left := rectInPort.left + h; 

001944 |RectIinView.top := rectinPort.top + v 

001945 [RectI nView. right := rectInPort. right + h; 

001946 |RectIinView. bottom := rectI nPort, bottom + v; 

001947 END; 

001948 {$1FC fTrace}EP; {$ENDC} 

001949 END: 

001950 {$8 SgDRWres} 

001951 

001952 

001953 PROCEDURE TPad. SetPen( pen: PenState); 

001954 VAR | Pat: LPattern; 

001955 BEGIN 

001956 {$I1FC fTrace}BP(7); {$ENDC} 

001957 [F amPrinting THEN 

001958 BEGIN 

001959 noPad. PatToLPat(pen. pnPat, | Pat); 

001960 SELF. LPatToPat(I Pat, pen. pnPat); 

001961 END; 

001962 Set PenState( pen) 

001963 {$I1FC fTrace}EP; {$ENDC} 
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001964 END; 

001965 

001966 

001967 

001968 PROCEDURE TPad. SetPenToHi ghlight(highTransit: THighTransit); 
001969 BEGIN 

001970 {$I1FC fTrace}BP(7); {$ENDC} 

001971 SELF. SetPen(highPen[highTransit]); 

001972 {$I1FC fTrace}EP; {$ENDC} 

001973 END; 

001974 

001975 

001976 PROCEDURE TPad. SetScrollOffset(VAR newOffset: LPoint); 

001977 {recalculates the origin and cdOffset fields; does not change arg} 
001978 VAR vhs: VHSel ect 

001979 BEGIN 

001980 {$I1FC fTrace}BP(7); {$ENDC} 

001981 WITH SELF DO 

001982 BEGIN 

001983 scrollOffset := newOffset:; 

001984 

001985 FOR vhs := v TO h DO 

001986 BEGIN 

001987 origin. vh[vhs] := newOffset.vh[ vhs] MOD magi cNumber 
001988 cdOffset.vh[vhs] := newOffset.vh[ vhs] - origin. vh[ vhs] 
001989 END; 

001990 END; 

001991 {$IFC fTrace}EP; {$ENDC} 

001992 END; 

001993 

001994 

001995 {$S Override} 

001996 PROCEDURE TPad. SetZoomFactor; {.... ONLY SEEMS TO BE RELEVANT FOR PANE--NONSENSE HERE FOR NOW} 
001997 BEGIN 

001998 {$IFC fTrace}BP(7); {$ENDC} 

001999 {$I1FC fTrace}EP; {$ENDC} 

002000 END; 

002001 

002002 

002003 {$8 SgABCdat } 

002004 PROCEDURE TPad. DrawLText(textBuf: Ptr; startByte, numBytes: | NTEGER) 
002005 BEGIN 

002006 {$1 FC fMaxTrace}BP( 1); {$ENDC} 

002007 {$IFC fMaxTrace}EP; {$ENDC} 

002008 WITH SELF.zoomFactor DO {$H- } 

002009 {$1FC libraryVersion > 20} 

002010 StdText(numBytes, QDPtr(ORD(textBuf) + startByte), numerator, denomi nator) 


002011 {$ELSEC} 
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002012 DrawText(WordPtr(textBuf), startByte, numBytes) 
002013 {$ENDC} {$H+} 

002014 END; 

002015 {$8 SgDRWres} 

002016 

002017 {$8 SgABCi ni } 

002018 BEGIN 

002019 

002020 Unit Author('Apple') 

002021 printerPseudoPort := POINTER( 0) 
002022 crashPad := NIL: 

002023 SetPt(screenRes, 90, 60); 
002024 

002025 | Pat White = LPattern( white) 
002026 | Pat Bl ack = LPattern(bl ack) 
002027 | Pat Gray := LPattern(gray) 
002028 [PatLtGray := LPattern(ItGray); 
002029 | Pat DkGray := LPattern(dkGray); 
002030 

002031 amPrinting := FALSE; 


002032 END; 
002033 {$8 SgDRWres} 


002034 

002035 

002036 METHODS OF TBranchArea: 

002037 

002038 

002039 {$S SgABCcl d} 

002040 FUNCTION TBranchArea. CREATE( object: TObject; heap: THeap; vhs: VHSelect; hasElderFirst: BOOLEAN 
002041 whoCanResizelt: TResizability; 
002042 itsElderChild, itsYoungerChild: TArea): TBranchArea; 
002043 BEGIN 

002044 {$I1FC fTrace}BP(7); {$ENDC} 

002045 IF object = NIL THEN 

002046 object := NewObject(heap, THISCLASS) 

002047 SELF := TBranchArea(obj ect); 

002048 

002049 WITH SELF DO 

002050 BEGIN 

002051 outerRect := itsElderChild. outerRect; 

002052 parentBranch := itsElderChild. parent Branch; 

002053 arrangement := vhs 

002054 elderFirst := hasElderFirst; 

002055 resizability := whoCanResizelt; 

002056 elderChild := itsElderChild: 

002057 youngerChild := itsYoungerChil d; 

002058 END; 

002059 
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itsElderChild.parentBranch := SELF; 
itsYoungerChild. parentBranch := SELF; 
{$IFC fTrace}EP; {$ENDC} 


SgDRWres} 


{$1 FC fDebugMet hods} 


{$$ 


SgABCdbg} 


PROCEDURE TBranchArea. Fields( PROCEDURE Field(nameAndType: $255)) 


BEGI 


END; 
{$5 


N 

TArea. Fields( Field); 
Field('arrangement: Byte'); 
Field('elderFirst: BOOLEAN’ ) 
Field('resizability: Byte'); 
Field('elderChild: TArea'); 
Field('youngerChild: TArea' ) 


SgDRWres} 


{$ENDC} 


{$$ 


SgABCcl d} 


PROCEDURE TBranchArea. Get Mi nExtent( VAR minExtent: Point; windowlsResizinglt: BOOLEAN) 


BEGI 


END; 
{$5 


{$$ 


VAR el derMi nSize: Point; 
younger Mi nSize: Point; 
vhs: VHSel ect; 

N 

{$I FC fTrace}BP(7); {$ENDC} 

vhs := SELF. arrangement 


SELF. elderChild. Get Mi nExtent(elderMinSize, TRUE); 
SELF. youngerChild. Get Mi nExtent(youngerMi nSize, TRUE); 


IF windowlsResizinglt AND NOT (windowCanResizelt IN SELF.resizability) THEN 
younger Mi nSize. vh[ vhs] := LengthRect( SELF. youngerChild.outerRect, vhs) 


mi nExtent.vh[vhs] := elderMinSize.vh[ vhs] + younger Mi nSize. vh[vhs] 

vhs := orthogonal [vhs] 

mi nExtent.vh[ vhs] := Max(elderMinSize.vh[ vhs], youngerMi nSize. vh[vhs]); 
{$I FC fTrace}EP; {$ENDC} 

SgDRWres} 

SgABCcl d} 


FUNCTION TBranchArea. OtherChild(child: TArea): TArea; 
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002108 BEGIN 

002109 {$I1FC fTrace}BP(7); {$ENDC} 

002110 IF SELF.elderChild = child THEN 

002111 OtherChild := SELF. youngerChild 

002112 ELSE 

002113 {$1 FC fDbgDraw} 

002114 [F SELF. youngerChild = child THEN 

002115 OtherChild := SELF. elderChild 

002116 ELSE 

002117 ABCBreak('This panel branch does not have a child that is', ORD(child)); 
002118 {$ELSEC} 

002119 OtherChild := SELF. elderChild; 

002120 {$ENDC} 

002121 {$I1FC fTrace}EP; {$ENDC} 

002122 END; 

002123 {$S SgDRWres} 

002124 

002125 

002126 {$S SgABCcl d} 

002127 PROCEDURE TBranchArea. Redivide(newCd: | NTEGER) 
002128 VAR elderRect: Rect; 

002129 younger Rect: Rect; 

002130 BEGIN 

002131 {$1FC fTrace}BP(7); {$ENDC} 

002132 elderRect := SELF. elderChild. outerRect 

002133 youngerRect := SELF. youngerChild. outerRect; 
002134 

002135 TRectCoords(elderRect)[SELF.elderFirst].vh[ SELF. arrangement] := newCd 
002136 TRectCoords(youngerRect)[NOT SELF.elderFirst].vh[SELF. arrangement] := newCd 
002137 

002138 SELF. el derChild. ResizeOutside(elderRect); 
002139 SELF. youngerChild. Resi zeOutsi de(youngerRect); 
002140 {$I1FC fTrace}EP; {$ENDC} 

002141 END: 

002142 {$S SgDRWres} 

002143 

002144 

002145 {$S SgABCcl d} 

002146 PROCEDURE TBranchArea. Repl aceChild(child, newChild: TArea); 
002147 BEGIN 

002148 {$IFC fTrace}BP(7); {$ENDC} 

002149 IF SELF.elderChild = child THEN 

002150 SELF. elderChild := newChild 

002151 ELSE 

002152 {$1 FC fDbgDraw} 

002153 [F SELF. youngerChild = child THEN 

002154 SELF. youngerChild := newChild 

002155 ELSE 
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002156 ABCBreak('This panel branch does not have a child that is', ORD(child)); 
002157 {$ELSEC} 

002158 SELF. youngerChild := newChild; 

002159 {$ENDC} 

002160 

002161 newChild. parent Branch := SELF; 

002162 1F child. parentBranch = SELF THEN 

002163 child. parentBranch := NIL; 

002164 {$1FC fTrace}EP; {$ENDC} 

002165 END: 

002166 {$S SgDRWres} 

002167 

002168 

002169 {$S SgABCcl d} 

002170 PROCEDURE TBranchArea. Resi zeOutside(newOuterRect: Rect); 
002171 VAR formerRect: Rect; 

002172 elderChild: TArea 

002173 youngerChil d: TArea; 

002174 elderRect: Rect; 

002175 younger Rect: Rect; 

002176 vhs: VHSel ect; 

002177 eldFirst: BOOLEAN 

002178 mi nExtents: ARRAY [FALSE.. TRUE] OF Point; 

002179 newCd: INTEGER; 

002180 deltaRect: Rect; 

002181 BEGIN 

002182 {$I1FC fTrace}BP(7); {$ENDC} 

002183 formerRect := SELF. outerRect; 

002184 

002185 elderChild := SELF. elderChild; 

002186 youngerChild := SELF. youngerChild; 

002187 

002188 elderRect := elderChild. outerRect; 

002189 youngerRect := youngerChild. outerRect; 

002190 

002191 vhs := SELF. arrangement 

002192 eldFirst := SELF.elderFirst; 

002193 

002194 1F windowCanResizelt IN SELF.resizability THEN 

002195 BEGIN {both children resize proportionally} 

002196 MapRect(elderRect, formerRect, newOuterRect); 

002197 MapRect(youngerRect, formerRect, newOuterRect); 
002198 

002199 elderChild. Get MinExtent(minExtents[ NOT eldFirst], TRUE); 
002200 youngerChild. Get Mi nExtent(minExtents[eldFirst], TRUE) 
002201 

002202 IF (minExtents[FALSE].vh[vhs] + minExtents[TRUE].vh[vhs]) < LengthRect(newOuterRect, vhs) THEN 
002203 BEGIN {lt is possible to satisfy both min constraints, so do so} 
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002204 newCd := Max(newOuterRect.topLeft.vh[vhs] + minExtents[ FALSE]. vh[vhs] 
002205 Min(newOuterRect.botRight.vh[vhs] - minExtents[ TRUE]. vh[vhs] 
002206 TRectCoords(elderRect)[eldFirst].vh[vhs])); 
002207 TRectCoords(elderRect)[eldFirst].vh[vhs] := newCd 

002208 TRectCoords(youngerRect)[NOT eldFirst].vh[vhs] := newCd 
002209 END; 

002210 END 

002211 

002212 ELSE 

002213 BEGIN {only elder child resizes in my direction} 

002214 Rect Mi nusRect(newOuterRect, formerRect, deltaRect); 

002215 RectPlusRect(elderRect, deltaRect, elderRect); 

002216 

002217 TRectCoords(deltaRect)[NOT eldFirst].vh[vhs] := TRectCoords(deltaRect)[eldFirst].vh[ vhs] 
002218 RectPlusRect(youngerRect, deltaRect, youngerRect); 

002219 END; 

002220 

002221 youngerChild. Resi zeOutsi de( younger Rect); 

002222 elderChild. Resi zeOutside(elderRect); 

002223 SELF.outerRect := newOuterRect; 

002224 {$I1FC fTrace}EP; {$ENDC} 

002225 END: 

002226 {$S SgDRWres} 

002227 

002228 

002229 {$S SgABCcl d} 

002230 FUNCTION TBranchArea. TopLeftChild: TArea 

002231 BEGIN 

002232 {$I1FC fTrace}BP(7); {$ENDC} 

002233 IF SELF.elderFirst THEN 

002234 ToplLeftChild := SELF. elderChild 

002235 ELSE 

002236 ToplLeftChild := SELF. youngerChild; 

002237 {$I1FC fTrace}EP; {$ENDC} 

002238 END: 

002239 {$S SgDRWres} 

002240 


002241 {$5 SgABCini} 
002242 END; 

002243 {$$ SgDRWres} 
002244 {$$ SgABCini} 
002245 

002246 

002247 


End of File -- Lines: 2247 Characters: 58490 
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000001 UNIT UObj ect; 

000002 {Copyright 1983, 1984, Apple Computer, Inc. } 

000003 {Implementation is in VOB) ECT2- 3-4} 

000004 

000005 {$SETC Isintrinsic := TRUE} 

000006 

000007 {$I1FC Isintrinsic} 

000008 INTRINSIC; 

000009 {$ENDC} 

000010 

000011 {$SETC ErrsToFile := TRUE } 

000012 

000013 {$IFC ErrsToFil e} 

000014 {$E+} 

000015 {RRR R RRR R RRR R RARER RARER RRA KER K KKH EK | {$E ERRS. TEXT} {BERR EERE RRR R RRR H RR RRR RK ER RRA KE HK KY} 
000016 {$ENDC} 

000017 

000018 {NOTE: The implementation of class TObject is quite obscure because this is actually system-type code} 
000019 

000020 {Segments: SgABCini(tialize), SgABCdat(a structures), SgABCdbg} 


000021 

000022 { 

000023 saasnrasssssssssssssssssssessssssssssscsss= SPECIFICALLY IN UObj ect SESS SSS sss sss esses ssssssssssssss 
000024 

000025 ----++-++5. CLASSES--==== we ewe ee VARI ABLES----- +--+ 2222 eee eee cee COMMENTS --------=- 
000026 

000027 TObj ect 

000028 

000029 TCollection size dynOffset holeStart holeSize holeStd -» indexed access (At, InsAt 
000030 Each) 

000031 TList -- contains object handles 
000032 TArray recordBytes -- contains records (even 
000033 lengths) 

000034 TString -- contains characters 

000035 TFile path scanners -- disk file (Exists, Rename) 
000036 TScanner collection position increment scanDone atEnd -- sequential access (Scan, 
000037 Insert) 

000038 TListScanner -- an object at a time 

000039 TArrayScanner -- a record at a time 

000040 TStringScanner error actual -- a character at a time (Xfer) 
000041 TFileScanner accesses refnum -- through a whole TFile 

000042 

000043 
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000044 sassnszsssssssssssssssssssssssssssssssss= | N ALL DATA STRUCTURE UNITS easssssteesstssssssssssssssssssssssssss 
000045 
000046 === KEY ===> $ = in UObject @= in UHuge * in UDb # in UMac 
000047 
000048 ----++-++.-. CLASSES---++22 5+ = wee wee VARI ABLES---++ +++ +2222 eee eee eee COMMENTS --------=- 
000049 
000050 $ TObject 
000051 
000052 $ TCollection size dynOffset holeStart holeSize holeStd -- indexed access (At, InsAt 
000053 Each) 
000054 $ TList - contains object handles 
000055 @ TLinkList head tail - stored in TLinks 
000056 @ THugeList hugeArray - stored in linked blocks 
000057 $ TArray recordBytes - contains records (even 
000058 lengths) 
000059 @ THugeArray mi nBlockLength maxBlockLength blocks - impl. with linked blocks 
000060 $ TString - contains characters 
000061 $ TFile path scanners - disk file (Exists, Rename) 
000062 TDb - contains keyed records 
000063 7 TDbFile file rScanDesc - key is a PAOC/String 
000064 : TRsFile endincrement firstKey lastKey scanners - key is a LONGINT (Swapln) 
000065 ‘ TDbRsFile dbFile - implemented with a 
000066 TDbFile 
000067 # TMcRsFile 22? - implemented in the Mac 
000068 ROM 
000069 
000070 $ TScanner collection position increment scanDone atEnd -- sequential access (Scan, 
000071 Insert) 
000072 $ TList Scanner - an object at a time 
000073 @ TLnkLst Scanner scanLi nk 
000074 @ THgeLst Scanner bl kArrScanner 
000075 $ TArrayScanner - a record at a time 
000076 @ THgeArr Scanner cacheBl ock cachel ndex - through a THugeArray 
000077 TStringScanner error actual - a character at a time (Xfer) 
000078 $ TFileScanner accesses refnum - through a whole TFile 
000079 TRs Scanner whichWay key buffer - through a single resource 
000080 ‘ TDbScanner error - a key at a time 
000081 : TDbFi Scanner rScanDesc - through a TDbFile 
000082 * TRsFi Scanner - a resource at a time 
000083 a TDbRsFi Scanner dbRecSeq dbRecSize - through a TDbRsFile 
000084 # TMcRsFi Scanner 222 - implemented in the Mac 
000085 ROM 
000086 
000087 @ TLink element next - has one element of a TLinkList 
000088 } 
000089 
000090 INTERFACE 
000091 {$SETC LibraryVersion := 30 } { 10 1.0 libraries; 13 = 1.3 libraries; Pepsi 
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000092 29 = V12.0 Libraries, 30 = V13.0+ libraries } 
000093 {$SETC compatibleLists := FALSE } 

000094 

000095 USES 

000096 

000097 UnitStd, 

000098 UnitHz, 

000099 {$U - #BO0T- SysCal | } SysCall, 

000100 {$lFC LibraryVersion > 20} 

000101 {$U LIBTK/ Passwd } Passwd 


000102 {$ENDC} 
000103 {$IFC LibraryVersion <= 20} 


000104 {$U UClascal } UCl ascal 

000105 {$ELSEC} {$l FC LibraryVersion < 30} 

000106 {$U LI BTK/ UCI ascal } UClascal, {Needed for interface} 
000107 {$ELSEC} 

000108 {$U LI BPL/ UCI ascal } UClascal, {Needed for interface} 


000109 {$ENDC} 
000110 {$ENDC} 


000111 { The next units needed to find out where the printer is located, from parameter memory 
000112 so we can tell Paslib where it is. (Needed for debugger Output Redirect.) } 
000113 PmDecl, 

000114 Pmm, 

000115 {$lFC LibraryVersion > 10} 

000116 {$U LIBPL/ PaslibCall} PaslibCall 

000117 {$U LIBPL/PPasLibc } PPasLibC, 

000118 {$ENDC} 

000119 

000120 {$U HW nt} HW nt; 

000121 

000122 


000123 {$SETC fDbgOk 
000124 {$SETC fSym0K 


TRUE}{FALSE} {override UnitStd to test Tool Kit} 
TRUE}{FALSE} {override UnitStd to test Tool Kit} 


000125 
000126 {$SETC fDbgObj ect := f DbgOK} 
000127 {$SETC fRngObj ect := f DbgOK} 
000128 {$SETC fSymObj ect = f Sym0K} 
000129 


000130 {$SETC fDebugMethods := fDbgObject} {include debugging methods in the compil ation} 
000131 

000132 {$SETC fCheckHeap 
000133 {$SETC fTrace 
000134 {$SETC fMaxTrace 
000135 

000136 {$SETC fCheckindices := fDbgObject} {if VAR also true, check subscripts} 
000137 

000138 CONST 

000139 


fDbgObject} {if VAR also true, check heap} 
fDbgObject} {if VAR also true, trace entries/exits} 
fTrace AND FALSE} {if TRUE trace entries/exits on minor procedures too} 
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000140 presLdsn = 1; {I dsn for the process data segment } 

000141 prcsDsBytes = 15000; {default heap size for a process data segment} 
000142 

000143 Max Breaks = 10; 

000144 

000145 outputRMargin = 85; 

000146 erlnternal = 4200; {Stolen fromlist of errors in UABC for newHeap} 
000147 

000148 MAXLI NT = $7FFFFFFF; 

000149 

000150 TYPE 

000151 

000152 {Aliases needed to compile QuickDraw} 

000153 

000154 Ptr = “LONGI NT; 

000155 ProcPtr = Ptr: 

000156 Handle = “Ptr: 

000157 

000158 {Aliases for commonly used types} 

000159 

000160 $8 = STRI NG[8] 

000161 $255 = STRING[ 255]; 

000162 

000163 TFilePath = $255; {Increased from 66 because of the new hierarchical file system 
000164 corresponds to Pathname in SYSCALL} 

000165 TFilePart = STRING[32]; {length of each level in a pathname; corresponds to e name in SYSCALL} 
000166 TPassword = TFilePart; 

000167 

000168 THeap = Ptr; {alias for THz in UnitHz} 

000169 TClass = Ptr; {alias for TPSliceTable in UClascal } 

000170 

000171 Byte = -128..127 

000172 TPString = *$255; 

000173 

000174 TpINTEGER = “I NTEGER 

000175 TpLONGINT = *LONGI NT; 

000176 

000177 TAuthorName = STRING[ 32]; 

000178 TClassName = STRING[8] 

000179 

000180 TClassWorld = RECORD {Alias for TWorld in | MPLEMENTATI ON} 

000181 infRecs: TArray {OF name, size, author, & version information}; 

000182 classes: TArray {OF TClass -- the pointer in each Clascal object}; 
000183 authors: TArray {OF PACKED ARRAY [1..$1ZEOF(TAuthorName)] OF CHAR}; 
000184 aliases: TArray {OF PACKED ARRAY [1..$1ZEOF(TCl assName)] OF CHAR}; 
000185 END; 

000186 

000187 TEnumAccesses = (fRead, fWrite, fAppend, fPrivate); {not allowing global _refnum at this time} 
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TAccesses = SET OF TEnumAccesses 

Tl OMode = (fAbsolute, fRelative, fSequential); 
xReadWrite = (xRead, xWrite); 

SizeOfNumber = 1..4: 

TScanDirection = (scanForward, scanBackward); 


TConvResult = (cvValid, cvNoNumber, cvBadNumber, cvOverfl ow) 


{Classes} 
TObj ect = SUBCLASS OF NIL 


{Creation and Destruction} 
FUNCTION TObject.CREATE(object: TObject; heap: THeap): TObject; ABSTRACT 


PROCEDURE TObj ect. Become(object: TObj ect); {SELF becomes obj and former SELF is freed} 
FUNCTION TObject.Class: TClass; {its class pointer} 

FUNCTION TObject.CloneObject( heap: THeap): TObj ect; {clones just the object, not its dependents} 
FUNCTION TObject.Clone(heap: THeap): TObject; DEFAULT; {clones the object and its known dependents} 
PROCEDURE TObject.FreeObj ect; DEFAULT; {frees just the object, not its dependents} 
PROCEDURE TObject. Free; DEFAULT; {frees the object and its known dependents} 
FUNCTION TObject.Heap: THeap; {which heap it is in} 

FUNCTION TObject.HeapBytes: INTEGER; {number of bytes occupied in that heap} 
PROCEDURE TObject.Read(s: TStringScanner); {reads the object & its known dependents} 
PROCEDURE TObject. Write(s: TStringScanner); {writes the object & its known dependents} 


{Debuggi ng} 
{$1 FC fDebugMet hods} 
PROCEDURE TObject.Fields( PROCEDURE Field(nameAndType: $255)); DEFAULT; {See end of file for comment } 
PROCEDURE TObject. Debug(numLevels: INTEGER; memberTypeStr: $255); DEFAULT 
{writes an object down to numLevels: 
numLevels=0 => write only class 
numLevels=1 => write class, non-Object fields, and class of Object fields 
etc. } 
{$ENDC} 


{Version Conversion} 
PROCEDURE TObject.Convert(fromVersion: Byte); {Override it to finish conversion from an old version} 
FUNCTION TObject.JoinClass(newClass: TClass): TObject; {Called for you by version conversion} 


END; 


TCollecHeader = RECORD 


classPtr: TClass 
size: LONGI NT; {number of real elements, not counting the hole} 
dynStart: INTEGER; {bytes fromthe class ptr to the dynamic data; MAXINT if none all owed} 
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holeStart: | NTEGER; {0 = at the beginning, size = at the end; MAXINT = none all owed} 
hol eSi ze: INTEGER; {measured in MemberBytes units} 
hol eStd: | NTEGER; {if the holeSize goes to 0, how much to grow the collection by} 
END; 

TFastString = RECORD {only access ch[{i] when hole is at end & TString is not subclassed} 
header: TColl ecHeader; 
ch: PACKED ARRAY[1..32740] OF CHAR 
END; 


TPFast String 
THFast String 


“TFast String; 
ATPFast String; 


TArrayHeader = RECORD 


classPtr: TClass 

size: LONGI NT; {number of real elements, not counting the hole} 

dynStart: | NTEGER; {bytes fromthe class ptr to the dynamic data} 

holeStart: | NTEGER; {0 means hole at the beginning, size means hole at the end} 

hol eSi ze: INTEGER; {measured in MemberBytes units} 

hol eStd: | NTEGER; {if the holeSize goes to 0, how much to grow the collection by} 
recordBytes: INTEGER 

END; 


TCollection = SUBCLASS OF TObject 


{Variables} 
size: LONGI NT; {number of real elements, not counting the hole} 
dynStart: | NTEGER; {bytes fromthe class ptr to the dynamic data} 
holeStart: | NTEGER; {0 means hole at the beginning, size means hole at the end} 
hol eSi ze: INTEGER; {measured in MemberBytes units} 
hol eStd: | NTEGER; {if the holeSize goes to 0, how much to grow the collection by} 


{The field "size" is a LONGINT for the benefit of huge collections like remote data bases. 
It is always in the INTEGER range for non-subclassed TLists, TArrays, and TStrings. 


The field "“dynStart" is an offset from Handle(collection)* and tells where the dynamic part 
of the data is stored, if any. This convention allows subclasses to add fields. 


When editing a collection, there may be an unused "hole" somewhere in the storage block. The 
fields "holeStart" and "holeSize" specify (in member-sized units) the starting index of the 
hole and the length of the hole. When holeSize is zero, there is no hole. If members are 
added when there is no hole, the storage block is expanded to allow for at least another 
"holeStd" members, 


CREATE has an argument that lets the initial collection have a hole at the end, so that 
Ins- methods can be called to initialize the collection without any storage allocation 


StartEdit sets holeStd to its argument, which forces subsequent edit methods to leave intact 
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any hole they might form StopEdit squeezes out the hole and sets holeStd to zero, which 

forces subsequent edit methods that get called with no hole to squeeze out any hole they may form 
Thus, every StartEdit that has a nonzero argument should be terminated by a call on StopEdit to 
save space. } 


{Creation and Destruction} 
FUNCTION TCollection. CREATE(object: TObject; heap: THeap; initial Slack: INTEGER): TCollection; 
FUNCTION TCollection. Clone( heap: THeap): TObject; OVERRI DE; 


{Attributes} 
FUNCTION TCollection, MemberBytes: INTEGER; ABSTRACT; 
FUNCTION TCollection. Equals(otherCollection: TCollection): BOOLEAN; 


{Slack control } 
PROCEDURE TCollection. StartEdit(withSlack: INTEGER); 
PROCEDURE TCollection. StopEdit; 


{Generic Inserts} 
PROCEDURE TCollection. I nsManyAt(i: LONGINT; otherCollection: TCollection; index, howMany: LONGI NT); 
PROCEDURE TCollection. I nsNullsAt(i, howMany: LONGI NT) 


(* BEGIN CONCEPTUAL METHODS (parameter types differ in subclasses; sometimes extra parameters required) 


{Enumerate members } 
PROCEDURE TCollection. Each( PROCEDURE DoToMember( member: "TMember")); CONCEPTUAL; 
FUNCTION TCollection. Pos(after: LONGINT; member: "TMember"): LONGINT; CONCEPTUAL; 
FUNCTION TCollection. Scanner: TScanner; CONCEPTUAL: {c. ScannerFrom(-MaxLI nt, scanForward) } 
FUNCTION TCollection. ScannerFrom(firstToScan: LONGINT; scanDirection: TScanDirecti on) 
: TScanner; CONCEPTUAL; 


{Inspect members} 
FUNCTION TCollection. At(i: LONGI NT): "TMember"; CONCEPTUAL; 
FUNCTION TCollection. First: "TMember"; CONCEPTUAL; 
FUNCTION TCollection. Last: "TMember"; CONCEPTUAL; 
FUNCTION TCollection. ManyAt(i, howMany: LONGINT): "TCollection"; CONCEPTUAL; 


{Insert members} 
PROCEDURE TCollection. | nsAt(i: LONGINT; member: "TMember"); CONCEPTUAL; 
PROCEDURE TCollection. | nsFirst( member: "TMember"); CONCEPTUAL: 
PROCEDURE TCollection. | nsLast( member: "TMember"); CONCEPTUAL; 


{Delete members} 
PROCEDURE TCollection. Del All; CONCEPTUAL; 
PROCEDURE TCollection. Del At(i: LONGINT); CONCEPTUAL: 
PROCEDURE TCollection. Del First; CONCEPTUAL: 
PROCEDURE TCollection. DelLast; CONCEPTUAL; 
PROCEDURE TCollection. Del ManyAt(i, howMany: LONGINT); CONCEPTUAL; 
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{Change member } 
PROCEDURE TCollection. PutAt(i: LONGINT; member: "TMember"); CONCEPTUAL; 


END CONCEPTUAL METHODS *) 
{Private methods -- to be called by subclasses only!!!} 


{$1 FC fRngObj ect} 
PROCEDURE TColl ection. Check! ndex(index: LONGI NT) 


{$ENDC} 

FUNCTION TCollection. AddrMember(i: LONGINT): LONGI NT; {The address is only valid momentarily} 
PROCEDURE TCollection. CopyMembers(dstAddr, startIindex, howMany: LONGI NT) 

PROCEDURE TCollection. EditAt(atI ndex: LONGINT; deltaMembers: INTEGER); {Transfers no data} 
PROCEDURE TColl ection. ResizeColl(membersPl usHole: | NTEGER); {Resizes at end, no fields changed} 


PROCEDURE TCollection. ShiftColl(afterSrclndex, afterDstIndex, howMany: INTEGER); {No fields 


END; 
TList = SUBCLASS OF TCollection 
{Variables} 


{Creation and Destruction} 
FUNCTION TList.CREATE(object: TObject; heap: THeap; initial Slack: INTEGER): TList; 
FUNCTION TList.Clone(heap: THeap): TObject; OVERRIDE; 
PROCEDURE TList. Free; OVERRIDE; 


{Debuggi ng} 
{$1 FC fDebugMet hods} 
PROCEDURE TList. Debug(numlLevels: INTEGER; memberTypeStr: $255); OVERRIDE; 
{ numLevels=0 print just class of list; 
1 also print size of list; 
2 also print compacted list of member classes 
>=3 print class, size, and call Debug(numLevels-1) on members 


} 
PROCEDURE TList. DebugMembers 
{$ENDC} 


{Attributes} 
FUNCTION TList.MemberBytes: INTEGER; OVERRIDE; 


{Enumerate members } 
PROCEDURE TList.Each( PROCEDURE DoToObject(object: TObject)); DEFAULT; 
FUNCTION TList.Pos(after: LONGINT; object: TObject): LONGI NT 
FUNCTION TList.Scanner: TListScanner 
FUNCTION TList.ScannerFrom(firstToScan: LONGINT; scanDirection: TScanDirecti on) 
: TListScanner; DEFAULT; 


{Inspect members} 
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FUNCTION TList.At(i: LONGINT): TObject; DEFAULT; 

FUNCTION TList. First: TObject; DEFAULT; 

FUNCTION TList.Last: TObject; DEFAULT 

FUNCTION TList. ManyAt(i, howMany: LONGINT): TList; DEFAULT; 


{Insert members} 
PROCEDURE TList.InsAt(i: LONGINT; object: TObject); DEFAULT; 
PROCEDURE TList.InsFirst(object: TObject); 
PROCEDURE TList.InsLast(object: TObj ect); 


{Delete members} 
PROCEDURE TList. Del All (freeOld: BOOLEAN); DEFAULT 
PROCEDURE TList. Del At(i: LONGINT; freeOld: BOOLEAN); DEFAULT; 
PROCEDURE TList. Del First(freeOld: BOOLEAN); 
PROCEDURE TList. DelLast(freeOld: BOOLEAN); 
PROCEDURE TList. Del ManyAt(i, howMany: LONGINT; freeOld: BOOLEAN); DEFAULT 
PROCEDURE TList. Del Object(object: TObject; freeOld: BOOLEAN) 
FUNCTION TList.PopLast: TObject 


{Change member } 
PROCEDURE TList. PutAt(i: LONGINT; object: TObject; freeOld: BOOLEAN); DEFAULT; 


END; 
TArray = SUBCLASS OF TCollection {*** WARNING: The Ptrs below become invalid if the heap compacts!!! } 
{Variables} 


recordBytes: INTEGER; 


{Creation and Destruction} 
FUNCTION TArray.CREATE(object: TObject; heap: THeap; initialSlack, bytesPerRecord: INTEGER): TArray; 


{Attributes} 
FUNCTION TArray.MemberBytes: INTEGER; OVERRI DE; 


{Enumerate members} 
PROCEDURE TArray.Each( PROCEDURE DoToRecord(pRecord: Ptr)); DEFAULT; 
FUNCTION TArray.Pos(after: LONGINT; pRecord: Ptr): LONGI NT; 
FUNCTION TArray. Scanner: TArrayScanner 
FUNCTION TArray.ScannerFromfirstToScan: LONGINT; scanDirection: TScanDirecti on) 
: TArrayScanner; DEFAULT; 


{Inspect members} 
FUNCTION TArray.At(i: LONGINT): Ptr; DEFAULT; 
FUNCTION TArray. First: Ptr; 
PROCEDURE TArray.GetAt(i: LONGINT; pRecord: Ptr); DEFAULT; {Sort of: pRecord* := SELF. At(i) *} 
FUNCTION TArray.Last: Ptr; 
FUNCTION TArray. ManyAt(i, howMany: LONGINT): TArray; DEFAULT 
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{Insert members} 
PROCEDURE TArray. 
PROCEDURE TArray. 
PROCEDURE TArray. 


{Delete members} 
PROCEDURE TArray. 
PROCEDURE TArray. 
PROCEDURE TArray. 
PROCEDURE TArray. 
PROCEDURE TArray. 


{Change member } 
PROCEDURE TArray. 


END; 


{Variables} 


{Creation and Destr 
FUNCTION TString 


{Attributes} 


FUNCTION TString, 


{Enumerate members } 


PROCEDURE TString. 
FUNCTION TString. 
FUNCTION TString. 
FUNCTION TString. 


{Inspect members} 
FUNCTI ON 
FUNCTI ON 
FUNCTI ON 
FUNCTI ON 


{Insert members} 
PROCEDURE TString 
PROCEDURE TString 
PROCEDURE TString 
PROCEDURE TString 


Apple Lisa ToolKit 3.0 Source Code Listing 


TString. 
TString. 
TString. 
TString. 
PROCEDURE TString. 
PROCEDURE TString. 
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InsAt(i: LONGI NT; 
InsFirst(pRecord: 
InsLast(pRecord: 


pRecord: Ptr); DEFAULT; 
Ptr): 
Ptr): 


Del All; 
Del At(i: 
Del First: 
DelLast; 

Del ManyAt(i, 


DEFAULT; 


LONGI NT); DEFAULT; 


howMany: LONGINT); DEFAULT; 
PutAt(i: 


LONGI NT; pRecord: Ptr); DEFAULT; 


TString = SUBCLASS OF TCollection 


uction} 
.CREATE( object: TObj ect; 


MemberBytes: INTEGER; OVERRIDE; 


Each( PROCEDURE DoToCharacter(character: CHAR) ) 
Pos(after: LONGINT; character: CHAR): LONGINT; 
Scanner: TStringScanner; 


ScannerFrom(firstToScan: LONGI NT; 


At(i: LONGI NT): 
First: CHAR; 
Last: CHAR; 
ManyAt(i, howMany: LONGINT): TString; 
ToPStr(pStr: TPString); 
ToPStrAt(i, howMany: LONGI NT; 


CHAR; 


pStr: TPString); 


» i nsAt(i: LONGINT; 
i nsFirst(character: CHAR); 
.insLast(character: CHAR) 

-PnsPStrAt(i: LONGINT; pStr: TPString); 


character: CHAR) 


heap: THeap; initial Slack: 


scanDirection: 


TScanDirection): 


568 of 


INTEGER): TString; 
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{Delete members} 
PROCEDURE TString. Del Al| 
PROCEDURE TString. Del At(i: LONGINT); 
PROCEDURE TString. Del First 
PROCEDURE TString. Del Last; 
PROCEDURE TString. Del ManyAt(i, howMany: LONGI NT) 


{Change member } 
PROCEDURE TString. PutAt(i: LONGINT; character: CHAR); 


{Qui ckDraw} 
PROCEDURE TString. Draw(i: LONGINT; howMany: INTEGER); 
FUNCTION TString. Width(i: LONGINT; howMany: INTEGER): INTEGER 
END; 


TFile = SUBCLASS OF TCollection 


{Variables} 
path: TFilePath; 
password: TPassword; {The current password protecting this file, and used for al 


accesses to it; client is responsible for setting this 
field after the TFile is created; ignored if 
LibraryVersion <= 20} 

scanners: TList {OF TScanner}; 


{Creation and Destruction} 
FUNCTION TFile. CREATE(object: TObject; heap: THeap; itsPath: TFilePath; 
itsPassword: TPassword): TFile: 
{itsPassword is ignored from LibraryVersion <= 20} 


PROCEDURE TFile. Free; OVERRI DE; {Frees the scanners as well } 
FUNCTION TFile.Clone(heap: THeap): TObject; OVERRIDE; {Illegal} 


{Attributes} 
FUNCTION TFile. MemberBytes: INTEGER; OVERRIDE; 


{Enumerate members} 
FUNCTION TFile. Scanner: TFileScanner; {f. ScannerFrom(0, [fRead, fWrite]) } 
FUNCTION TFile.ScannerFrom(firstToScan: LONGINT; manip: TAccesses): TFileScanner 


{Catal og} 
PROCEDURE TFile. ChangePassword(VAR error: INTEGER; newPassword: TPassword) 
{also changes the password field, if successful } 
PROCEDURE TFile. Delete(VAR error: INTEGER); 
FUNCTION TFile. Exists(VAR error: INTEGER): BOOLEAN 
FUNCTION TFile. WhenModified(VAR error: INTEGER): LONGINT; 
PROCEDURE TFile. Rename(VAR error: INTEGER; newFileName: TFilePath); 
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FUNCTION TFile. VerifyPassword( VAR error: INTEGER; password: TPassword): BOOLEAN 


END; 


TScanner = SUBCLASS OF TObj ect 


{Variables} 

collection: TCollection; {The collection being scanned} 

position: LONGI NT; {The current position (between members: O=before first, size+l=after 
last) } 

increment: INTEGER; {1 if scanning forward, -1 if scanning backward} 

scanDone: BOOLEAN; {TRUE if next .Scan call should return FALSE, leaving its VAR 
parameter alone} 

atEnd: BOOLEAN; {TRUE if next .Scan call will return FALSE because at end of collection} 


FUNCTION TScanner. 


{Close and Reopen} 


PROCEDURE TScanner. 
PROCEDURE TScanner. 


{Slack Control } 


PROCEDURE TScanner. 
PROCEDURE TScanner. 


{Positioning} 


FUNCTION TScanner. 
PROCEDURE TScanner. 
PROCEDURE TScanner. 
PROCEDURE TScanner. 
PROCEDURE TScanner. 


CREATE(object: TObject; itsCollection: TCollection; itsInitial Position: LONGINT; 
scanDirection: TScanDirection): TScanner 


Close; DEFAULT; {lf disk-based, flush buffers and tell OS to close file, 
else no-op} 
Open; DEFAULT; {If disk-based, tell OS to reopen file and fill first buffer} 


Allocate(slack: LONGI NT); DEFAULT; {Like collection. StartEdit(slack) } 
Compact; DEFAULT; {Like collection. StopEdit} 


Advance( PROCEDURE DoToCurrent(anotherMember: BOOLEAN)): BOOLEAN 


Done; DEFAULT; {Set scanDone so that Scan will return FALSE} 
Reverse; DEFAULT; {Reverse the scan direction} 
Seek(newPosition: LONGINT); DEFAULT; {Forces to legal places} 

Ski p(deltaPos: LONGINT); DEFAULT; {Forces to legal places} 


(* BEGIN CONCEPTUAL METHODS (parameter types differ in subclasses; sometimes extra parameters required) 


{Data Transfer} 


FUNCTION TScanner. 
FUNCTION TScanner. 


{Editing} 


PROCEDURE TScanner. 
PROCEDURE TScanner. 


PROCEDURE TScanner. 
PROCEDURE TScanner. 


Obtain: "TMember"; CONCEPTUAL; {Return previous member (redundant right after 
Scan) } 
Scan(VAR member: "TMember"): BOOLEAN; CONCEPTUAL; {Return next & advance past it} 


Append(member: "TMember"); CONCEPTUAL; {Add a new member after position, scan 


past it} 

Delete; CONCEPTUAL; {Delete previous member and adjust 
position} 

DeleteRest; CONCEPTUAL; {Delete everything after SELF. position} 


Replace(member: "TMember"); CONCEPTUAL; {Replace previous member and maintain 
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END CONCEPTUAL 
END; 
TListScanner 


{Variables} 


Ap 
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METHODS *) 


position} 


= SUBCLASS OF TScanner 


{Creation and Destruction} 


FUNCTION TListScanner. CREATE( object: TObj ect; 


PROCEDURE 


{Traversal } 
FUNCTI ON 
FUNCTI ON 


{Editing} 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 
END; 

TArrayScanner 


{Variables} 


TListScanner. 


TListScanner. 
TListScanner. 


TListScanner. 
TListScanner. 
TListScanner. 
TListScanner. 


itsList: TList; itsInitial Position 
TScanDirection): TListScanner 


LONGI NT; 
itsScanDirection: 


Free; OVERRIDE; 


Obtain: TObject; DEFAULT; {Return previous member (redundant right after Scan) } 
Scan(VAR nextObject: TObject): BOOLEAN; DEFAULT; {Return next, advance past it} 


Append(object: TObject); DEFAULT; {Add object after position, scan past it} 
Delete(freeOld: BOOLEAN); DEFAULT; {Delete previous object, adjust position} 
DeleteRest(freeOld: BOOLEAN); DEFAULT; {Delete all objects after position} 


Replace(object: TObject; freeOld: BOOLEAN); DEFAULT; {Replace previ ous} 


= SUBCLASS OF TScanner 


{Creation and Destruction} 


FUNCTION TArrayScanner. CREATE( object: TObj ect; 


PROCEDURE 


{Traversal } 
FUNCTI ON 
FUNCTI ON 


{Editing} 
PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


END; 


TArrayScanner 


TArrayScanner. 
TArrayScanner. 


TArrayScanner 


TArrayScanner. 
TArrayScanner. 
TArrayScanner. 


Apple Lisa 


itsArray: TArray; itsInitial Position 
itsScanDirection: TScanDirection): TArrayScanner; 
OVERRI DE; 


LONGI NT; 


. Free; 


Obtain: Ptr; DEFAULT; {Return previous member (redundant right after Scan) } 


Scan(VAR pNextRecord: Ptr): BOOLEAN; DEFAULT; {Return next & advance past it} 
.-Append(pRecord: Ptr); DEFAULT; {Add a new record after position, scan past it} 
Delete; DEFAULT; {Delete previous record and adjust position} 
DeleteRest; DEFAULT; {Delete all records after position} 


Replace(pRecord: Ptr); DEFAULT; {Replace previous record and maintain position} 
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TStringScanner = SUBCLASS OF TScanner 


{Variables} 
actual: LONGI NT; {no. bytes last xfered} 


{Creation and Destruction} 
FUNCTION TStringScanner. CREATE(object: TObject; itsString: TString; itsInitial Position: LONGI NT 
itsScanDirection: TScanDirection): TStringScanner 
PROCEDURE TStringScanner. Free; OVERRI DE; 


{Traversal } 
FUNCTION TStringScanner. Obtain: CHAR; DEFAULT; {Return previous member (redundant right after Scan) } 
FUNCTION TStringScanner. Scan(VAR nextChar: CHAR): BOOLEAN; DEFAULT; {Return next & advance past it} 


{Editing} 
PROCEDURE TStringScanner. Append(character: CHAR); DEFAULT; {Add char after position, scan past it} 
PROCEDURE TStringScanner. Delete; DEFAULT; {Delete previous char, adjust position} 
PROCEDURE TStringScanner. DeleteRest; DEFAULT; {Delete all chars after position} 


PROCEDURE TStringScanner. Repl ace(character: CHAR); DEFAULT; {Replace previous char, maintain position} 


{Typed Sequential Data Transfer: characters are read/written fromleft to right regardless of increment} 
FUNCTION TStringScanner. ReadArray( heap: THeap; bytesPerRecord: INTEGER): TArray; {reads size first} 
FUNCTION TStringScanner. ReadNumber(numBytes: SizeOfNumber): LONGINT; {iff numBytes is even 

then signed} 
FUNCTION TStringScanner. ReadObject(heap: THeap): TObj ect; {tells object to Read( SELF) } 
PROCEDURE TStringScanner. WiteArray(a: TArray); {inverse of ReadArray: writes size but not 
recordBytes} 

PROCEDURE TStringScanner. WiteNumber(value: LONGINT; numBytes: SizeOfNumber); {does not write size} 
PROCEDURE TStringScanner. WiteObject(object: TObject); {tells object to Write( SELF) } 
PROCEDURE TStringScanner. XferConti guous(whichWay: xReadWrite; collection: TCollection); 

{xfers the size and members, non-recursively; xRead appends what it reads} 
PROCEDURE TStringScanner. XferFields(whichWay: xReadWrite; object: TObject); {xfers all but the class} 
PROCEDURE TStringScanner. XferPString(whichWay: xReadWrite; pStr: TPString); {it better be long enough} 


{Untyped Data Transfer: characters are read/written fromleft to right regardless of increment} 
PROCEDURE TStringScanner. XferSequential(whichWay: xReadWrite; pFirst: Ptr; numBytes: 
LONGI NT); DEFAULT; 
PROCEDURE TStringScanner. XferRandom( whichWay: xReadWrite; pFirst: Ptr; numBytes: LONGI NT; 
mode: TlOMode;: offset: LONGI NT); DEFAULT; 


END; 


TFileScanner = SUBCLASS OF TStringScanner 


{Variables} 
accesses: TAccesses; {[fRead, fWrite, fAppend, fPrivate] } 
refnum: INTEGER; {0S file refnum, or -1 if not open now} 
error: INTEGER; {EOF is not an error} {first error (or warning if no error) encountered} 
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{Creation and Destruction} 
FUNCTION TFileScanner. CREATE(object: TObject; itsFile: TFile; manip: TAccesses): TFileScanner 
PROCEDURE TFileScanner. FreeObj ect; OVERRI DE; {also closes the OS file} 
PROCEDURE TFileScanner. Free; OVERRIDE; {if the last scanner, frees the TFile, too} 


{Close and Reopen} 
PROCEDURE TFileScanner.Close; OVERRI DE; 
PROCEDURE TFileScanner. Open; OVERRI DE; 


{Slack Control } 
PROCEDURE TFileScanner. Allocate(slack: LONGINT); OVERRIDE; {Get slack DIV pageSize unused disk pages} 
PROCEDURE TFileScanner. Compact; OVERRIDE; {Return unused disk pages to free space} 


{Positioning} 
PROCEDURE TFileScanner. Seek(newPosition: LONGINT); OVERRIDE; 
PROCEDURE TFileScanner.Skip(deltaPos: LONGI NT); OVERRIDE; 


{Traversal } 
FUNCTION TFileScanner. Obtain: CHAR; OVERRIDE; {Return previous member (redundant right after Scan) } 
FUNCTION TFileScanner.Scan(VAR nextChar: CHAR): BOOLEAN; OVERRIDE; {Return next & advance past it} 


{Editing} 
PROCEDURE TFileScanner. Append(character: CHAR); OVERRIDE; {Acts like: Replace; Skip(1)} 
PROCEDURE TFileScanner. Delete; OVERRI DE; {Acts like: Skip(-1)} 
PROCEDURE TFileScanner. DeleteRest; OVERRI DE; {Shorten file size to SELF. position} 
PROCEDURE TFileScanner. Repl ace(character: CHAR); OVERRIDE; {Replace previous member and maintain 


position} 


{Untyped Data Transfer: characters are read/written fromleft to right regardless of increment} 
PROCEDURE TFileScanner. XferSequential(whichWay: xReadWrite; pFirst: Ptr; numBytes: LONGINT); OVERRIDE; 
PROCEDURE TFileScanner. XferRandom( whichWay: xReadWrite; pFirst: Ptr; numBytes: LONGI NT; 

mode: TlOMode; offset: LONGI NT); OVERRIDE; 


END; 
{$1FC compati bleLists} 
{Backward compatibility classes} 


TDynamicArray = SUBCLASS OF TArray 
ch: {UNPACKED} ARRAY [0..16370] OF CHAR 
FUNCTION TDynamicArray. CREATE(object: TObject; heap: THeap; bytesPerRecord: INTEGER 
initialSize: INTEGER): TDynamicArray; 
FUNCTION TDynamicArray.NumRecords: INTEGER 
PROCEDURE TDynamicArray. BeSize(newSize: INTEGER) 
END; 
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Ti ndexList = SUBCLASS OF TList 
elements: ARRAY[1..1] OF TObj ect 
FUNCTION TindexList. CREATE(object: TObject; heap: THeap; initialSize: INTEGER): TlndexList; 
FUNCTION TindexList. numElements: INTEGER 
END; 


TLinkList = SUBCLASS OF TList 
FUNCTION TLinkList.CREATE(object: TObject; heap: THeap): TLinkList 
FUNCTION TLinkList.numEl ements: INTEGER 
END; 


TBlockList = SUBCLASS OF TList 
FUNCTION TBlockList. CREATE(object: TObject; heap: THeap; itsMinBlockSize: INTEGER): TBlockList; 
FUNCTION TBlockList. numEl ements: INTEGER 
END; 


TFileStream = SUBCLASS OF TFileScanner 
FUNCTION TFileStream CREATE(object: TObject; heap: THeap; path: $255; manip: TAccesses): TFileStream 
FUNCTION TFileStream. Size: LONGI NT; 


END; 
{$ENDC} 
VAR 
mai nDs Ref num | NTEGER; {refnum of the process data segment } 
mai nHeap: THeap; {heap of the process} 
mai nbLdsn: INTEGER; {I dsn of the process data segment } 
fCheckl ndices: BOOLEAN 
onDesktop: BOOLEAN; {ls there a DM (Desktop Manager) to talk to?} 
wml sl nitialized: BOOLEAN; {Has OpenWM been done?} 
islnitialized: BOOLEAN; {I ff TRUE, shouldn't tell DMinitFailed any more} 
amDyi ng: BOOLEAN; {lff TRUE, | have called | mDyi ng} 
my Worl d: TClassWorld; {For Version Conversion} 


{ Variables for Debugging } 


indentTrace: INTEGER; 

{ stuff for the intelligent output } 
currXPos: INTEGER 
outputi ndent: INTEGER; 


{$IFC fTrace} 
{ TRUE if we want to inhibit tracing; client must save and restore its value 
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normally this is needed only if you override the Debug method } 


f DebugRecursi on: BOOLEAN; 

{ how often to call KeyPress from debugger to check for user interrupt } 
keyPresLi mit: INTEGER 
{$ENDC} 


{$1FC fCheckHeap} 
FUNCTION CountHeap(heap: THeap): INTEGER; 


{$ENDC} 


FUNCTI ON 
FUNCTI ON 


PROCEDURE 
PROCEDURE 
FUNCTI ON 


FUNCTI ON 
FUNCTI ON 
FUNCTI ON 


FUNCTI ON 
FUNCTI ON 
PROCEDURE 
FUNCTI ON 
PROCEDURE 
PROCEDURE 


Min(i, j: LONGINT): LONGI NT; 
Max(i, j: LONGINT): LONGI NT; 


XferLeft(source, dest: Ptr; nBytes: INTEGER); 
XferRight(source, dest: Ptr; nBytes: INTEGER) 
Equal Bytes(source, dest: Ptr; nBytes: INTEGER): BOOLEAN 


LI ntAndLInt(i, j: LONGI NT): LONGI NT; 
Li ntOrLint(i, j: LONGINT): LONGI NT; 
Li ntXorLIint(i, j: LONGI NT): LONGI NT; 


NewObject(heap: THeap; itsClass: TClass): TObject; 


NewDynObj ect( heap: THeap; itsClass: TClass; dynBytes: INTEGER): TObject 


Resi zeDynObject(object: TObject; newTotal Bytes: INTEGER) 


NewOrRecycledObj ect(heap: THeap; itsClass: TClass; VAR chainHead: TObject): TObject 


RecycleObject(object: TObject; VAR chainHead: TObj ect); 
Free(object: TObject); 


{$1FC compati bleLists} 
{Backward compatibility procedures} 


FUNCTI ON 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTI ON 
{$ENDC} 


FUNCTI ON 
FUNCTI ON 


PROCEDURE 
FUNCTI ON 


{The next 
PROCEDURE 
PROCEDURE 


SubObject(super: TObject; itsClass: TClass): TObject; 
FileDelete(path: $255); 

FileLookup(VAR error: INTEGER; path: $255); 
FileRename(oldPath, newPath: $255) 

FileModified(path: $255): LONGI NT; 


Superclass(class: TClass): TClass 
ClassDescendsFrom( descendant, ancestor: TClass): BOOLEAN 


NameOfClass(class: TClass; VAR className: TClassName); 
SizeOfClass(class: TClass): INTEGER; 


3 can only be called froma class-init block or a subroutine of a class-init block} 


Unit Author(companyAndAuthor: TAuthorName) ; 
ClassAuthor(companyAndAuthor: TAuthorName; classAlias: TCl assName); 
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000812 PROCEDURE ClassVersion(itsVersion, oldestIltCanRead: Byte); {opti onal } 
000813 

000814 FUNCTION ValidObject(hndl: Handle): BOOLEAN 

000815 

000816 PROCEDURE ABCBreak(s: $255; errCode: LONGI NT) 

000817 

000818 PROCEDURE ClascalError(error: INTEGER) 

000819 


000820 {Some useful procedures; we should decide once and for all whether or not to keep any or all of these} 
000821 PROCEDURE LI ntToHex(decNumber: LONGINT; hexNumber: TPString); 


000822 {NOTE: hexNumber must be >= 8 characters, regardless of size of decNumber} 

000823 PROCEDURE LIntToStr(decNumber: LONGINT; str: TPString); 

000824 {NOTE: str must be >= 11 characters (sign + 10 digits), regardless of size of decNumber} 
000825 PROCEDURE IntToStr(decNumber: INTEGER; str: TPString); 

000826 {NOTE: str must be >= 6 characters (sign + 5 digits), regardless of size of decNumber} 


000827 PROCEDURE HexStrToLInt(hexString: TPString; VAR decNumber: LONGINT; VAR result: TConvResult); 
000828 PROCEDURE StrToLI nt(str: TPString; VAR decNumber: LONGINT; VAR result: TConvResult); 

000829 PROCEDURE StrTolnt(str: TPString; VAR decNumber: INTEGER; VAR result: TConvResult) 

000830 

000831 PROCEDURE Tri mBlanks(str: TPString) 

000832 FUNCTION CharUpperCased(ch: CHAR): CHAR; 

000833 PROCEDURE StrUpperCased(str: TPString); 


000834 

000835 PROCEDURE SplitFilePath(VAR full Path, itsCatalog, itsFilePart: TFilePath); 

000836 {full Path = CONCAT(itsCatalog, itsFilePart} 

000837 

000838 PROCEDURE LatestError(newError: INTEGER; VAR previousError: | NTEGER) 

000839 {This is used to handle error codes returned by multiple operations, so that you end up with 
000840 the first error number or warning number (error code < 0) if there was no error. 

000841 You should pass in the latest error as 'newError’ and the variable that is to be the final 
000842 error code as 'previousError'. Here is the actual code of LatestError: 

000843 

000844 IF ((newError > 0) AND (previousError <= 0) OR 

000845 (newError < 0) AND (previousError = 0)) THEN 

000846 previousError := newError 

000847 } 

000848 


000849 {$lFC fDbgObj ect} 

000850 PROCEDURE EntDebugger(inputStr, enterReason: $255); 

000851 PROCEDURE DumpVar(pVariable: Ptr; nameAndType: $255); {used mainly by TProcess. DumpGl obal s} 
000852 PROCEDURE WStr(str: $255); { write a string with wrap-around } 
000853 PROCEDURE WLnh; { goto next line, and output indent } 
000854 {$lFC fDebugMet hods} 

000855 PROCEDURE WrObj(object: TObject; numLevels: INTEGER; memberTypeStr: $255) 
000856 {$ENDC} 

000857 {$ENDC} 

000858 

000859 {$lFC fDbgObj ect OR fDebugMet hods} 
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FUNCTION CheckKeyPress(routine: $255): BOOLEAN; 
{$ENDC} 


FUNCTION NewHeap(VAR error: INTEGER; heapStart, numBytes: LONGINT; numObjects: INTEGER): THeap 
FUNCTION MakeDataSegment(VAR error, dsRefnum: INTEGER; firstTryVolume, thenTryVolume: TFilePath; 
Idsn, memBytes, diskBytes: INTEGER): LONGI NT 


PROCEDURE SetHeap(heap: THeap); 
PROCEDURE GetHeap(VAR heap: THeap); 
{We can't USE Unit Storage because of type name conflicts (Ptr, Handle, ProcPtr) } 


FUNCTION NeedConversion(exClassWorld: TClassWorld; VAR olderVersion, newerVersion: BOOLEAN): BOOLEAN 
PROCEDURE ConvertHeap(heap: THeap; exClassWorld: TClassWorl d) 


PROCEDURE MarkHeap(heap: THeap; mpAddress: LONGI NT) 
PROCEDURE SweepHeap(heap: THeap; report: BOOLEAN) 


{$1 FC fTrace} 
PROCEDURE BP( MyTraceLevel:integer); 

{Trace entry to method and write SELF (unless CREATE, Debug, or FreeObj ect) } 
PROCEDURE EP; {Trace entry from method and write SELF (unless CREATE, Debug, FreeObject, or Free) } 
{$ENDC} 


(* sasssssssssccccccsssss== RULES FOR WRITING A Fields FUNCTION ==================== 


This function must be defined in every class until the compiler generates this info automatically! 


PROCEDURE TWhatever. Fields{(PROCEDURE Field(nameAndType: $255))}; 
BEGIN {THE FIELDS MUST BE LISTED IN DECLARED ORDER, NONE OMITTED AND NONE ADDED} 
{Tell the superclass first (unnecessary if it is TObj ect) } 
SUPERSELF. Fields( Field); 
{The following type names are recognized by the parser} 
Field('flag: BOOLEAN' ); 
Field('coCode: Byte') 
Field('inputChar: CHAR'); 
Field('version: INTEGER’) 
Field(' width: LONGI NT' ) 
Field('viewLPt: LPoint'); 
Field('boundLRect: LRect'); 
Field('size: Point'); 
Field('ptr: Ptr'); 
Field('boundRect: Rect'); 
Field('someName: STRING[100]'); 
{If the last field is a Byte or a BOOLEAN, force padding to a word boundary by.. 
Field(''); 
{Every Registered Class name is recognized} 
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Field('miscObj: TObject'); 
Field('myPanel: TPanel'); 
Field('mySel: TMySelection'); 
Field('appSpecific: TAppSpecific'); 


{You may report more than one field in a single call to reduce code space} 
Field('boundLRect: LRect; size: Point; ptr: Ptr; mySel: TMySelection'); 


{Unpacked invariant RECORDs are recognized} 
Field('info: RECORD version: INTEGER; size: Point END'); 


{If the record has variants, select among them before calling Field()} 


CASE SELF.variant OF 
flavorl: Field('RECORD version: INTEGER; size: Point END'); 
flavor2: Field('RECORD viewLPt: LPoint END'); 
END; 
{Unpacked ARRAYs with literal bounds are recognized} 


Field('desc: ARRAY [1..99] OF RECORD version: INTEGER; id: ARRAY [1..2] OF CHAR END'); 
{Other constructs and type names are NOT recognized; substitute one of the above forms} 


{As a last resort, use ARRAY [1..SIZEOF(SELF.fieldName)] OF Byte} 
END; 
*) 


| MPLEMENTATI ON 


{$1 LIBTK/ UOBJECT2.text} {Objects, Classes, Streams, and Resources} 
{$1 LIBTK/ VOB) ECT3.text} {Arrays and Lists} 
{$1 LIBTK/ VOB) ECT4.text} {Debugger} 


( FARR HK KK KX 


{$1 UOBJECT2.text} {Objects, Classes, Streams, and Resources} 
{$1 UOBJECT3.text} {Arrays and Lists} 


{$1 UOBJECT4.text} {Debugger} 
HARARE KKK KY) 


END. 


End of File -- Lines: 942 Characters: 42428 
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000001 {INCLUDE FILE UOBJ)ECT3 -- OBJECTS, CLASSES, RESOURCES, AND STREAMS} 

000002 {Copyright 1983, 1984, Apple Computer, Inc. } 

000003 

000004 {changed 05/01 1503 Changes to allow people to use Clascal on the Workshop} 
000005 

000006 {Segments: SgCLAini(tialize and Terminate), SgCLAres(ident), SgCLAc(o)Ild, SgCLAdbg} 
000007 

000008 {$%+} 

000009 

000010 {$I FC fRngObj ect} 

000011 {$R+} 

000012 {$ELSEC} 

000013 {$R-} 

000014 {$ENDC} 


“on 


000015 

000016 {$lFC fSymObj ect} 

000017 {$D+} 

000018 {$ELSEC} 

000019 {$D-} 

000020 {$ENDC} 

000021 

000022 CONST 

000023 

000024 trLevMemory = 60 

000025 { The std value of keyPresLimit, overridable by chaging the variable keyPresLimit } 
000026 stdKeyPresLimit = 10 

000027 maxTallies = 3000; { < 32K DIV SIZEOF(TTally) } 
000028 

000029 TYPE 

000030 

000031 $16 = STRING[ 16] 

000032 

000033 TPS8 = “*S8 

000034 TPByte = “Byte; 

000035 TPAOC = PACKED ARRAY[1..32767] OF CHAR 
000036 TpPAOC = “TPAOC 

000037 

000038 TppI NTEGER = *TpI NTEGER 

000039 

000040 TPObject = “TObj ect; 

000041 

000042 TPPathName = *Pat hName 

000043 TPEName = “E_ Name 


Apple Lisa ToolKit 3.0 Source Code Listing -- 579 of 1012 


000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 


Apple Lisa Computer Technical Information 


TRecycleChain = RECORD 
classPtr: TClass 
chainlink:  TObj ect; 
END; 


TPRecycl eChain 
THRecycl eChain 


“TRecycl eChain; 
“TPRecycl eChai n; 


UnsignedByte = 0..255; 


TTypeCode = (yBoolean, yHexByte, yByte, yChar, yHexlnteger, ylnteger, ylLongl nt, yLongReal 
yLPoint, yLRect, yObject, yPoint, yPtr, yReal, yRect, yString, yArray); 


{We can't USE Unit UDRAW because it USES us; these are needed in EXTERNAL decls below for KitBug} 


FakePoint = RECORD v, h: INTEGER END; 
FakeRect = RECORD top, left, bottom, right: INTEGER END 
FakeLPoint = RECORD v, h: LONGINT END 
FakeLRect = RECORD top, left, bottom right: LONGINT END 


{$1FC LibraryVersion < 20} 
{ The following definitions come from PasLibCall and PPasLi bC; 
will have to be changed too !!!! 
dsProcCode = (dsResProg, dsSoftPwhtn, dsPrintDev, dsSetGPrefix, dsEnbDisk); 


if those files change, these 


dsProcParam = record 


case ProcCode : dsProcCode of 


dsResProg : (RProcessid : longint); 
dsSoftPwhtn (SPButton : boolean) 
dsPrintDev (PrDevice : e name) 
dsSetGPrefix : (errnum: INTEGER 
prefix : pathname); 
dsEnbDi sk (DiskEvent : boolean); 
end; 
{$ENDC} 
{Tall ying} 
TTally = RECORD 
count: INTEGER 
microseconds: LONGI NT; 
epPC: LONGI NT; 
END; 


TTallyArray = ARRAY [1..maxTallies] OF TTally; 


TOTallyArray = 


RECORD 


header: TArrayHeader; 


recs: 


TTall yArray; 


Apple Lisa ToolKit 3.0 Source Code Listing 


{name "recs" must be different from "records" in THI dxArray} 


580 of 1012 


000092 
000093 
000094 
000095 
000096 
000097 
000098 
000099 
000100 
000101 
000102 
000103 
000104 
000105 
000106 
000107 
000108 
000109 
000110 
000111 
000112 
000113 
000114 
000115 
000116 
000117 
000118 
000119 
000120 
000121 
000122 
000123 
000124 
000125 
000126 
000127 
000128 
000129 
000130 
000131 
000132 
000133 
000134 
000135 
000136 
000137 
000138 
000139 


Apple Lisa Computer Technical Information 


END; 
TPDTallyArray = “TDTall yArray; 
THTallies = *TPDTallyArray; {An alias for a TArray of TTally} 


{Version Conversion Types} 


TDCl asses = RECORD 


header: TArrayHeader 
records: TClassArray; 
END; 
TPDClasses = “TDClasses 
THClasses = *TPDClasses; {An alias for a TArray of TClassInfo} 
TDSTables = RECORD 
header: TArrayHeader 
records: TSTabl eArray; 
END; 
TPDSTables = “TDSTables 
THSTables = *TPDSTables; {An alias for a TArray of TPSliceTabl e} 
TDAuthorArray = RECORD 
header: TArrayHeader 
records: TAuthorArray; 
END; 
TPDAuthorArray = *TDAuthorArray; 
THAuthors = “TPDAuthorArray; {An alias for a TArray of TA32 (company and author) } 
TDAliasArray = RECORD 
header: TArrayHeader 
records: TAliasArray; 
END; 
TPDAliasArray = “TDAliasArray; 
THAliases = “TPDAliasArray; {An alias for a TArray of TA8 (class alias) } 


TldxArray = ARRAY [1..16000] OF INTEGER 
TDI dxArray = RECORD 


header: TArrayHeader 
records: TldxArray; 
END; 

TPDI dxArray = “TDI dxArray; 

THI dxArray = *TPDI dxArray; {An alias for a TArray of I NTEGER} 

TWorld = RECORD 
hExCl asses: THCl asses; {hExClasses** .records[i] is the TClassInfo of class no. i} 
hExSTables: THSTables; {hExSTables** .records[i] is the TPSliceTable of class no. i} 
hExAuthors: THAut hors; {hExAuthors** .records[i] is the i'th companyAndAut hor encountered} 
hExAliases: THAliases; {hExAliases** .records[i] is the i'th classAlias encountered} 
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END; 
VAR 
hMyCl asses: THCl asses; {hMyClasses** .records[i] is the TClassInfo of class no. i} 
hMySTabl es: THSTabl es; {hMySTables** .records[i] is the TPSliceTable of class no. i} 
hMy Authors: THAut hors; {hMyAuthors** .records[i] is the i'th companyAndAuthor encountered} 
hMyAliases: THAliases; {hMyAliases** .records[i] is the i'th classAlias encountered} 
hMy HashName: THI dxArray; {hMyHashName**. records[hashlndex] is 0 or the index i of a class} 
cObj ect: TClass; {The TClass of TObj ect} 
{$1FC compatibleLists} {For TDynamicArray.Class and Tl ndexList. Class} 
cArray: TClass; {The TClass of TArray} 
cList: TClass; {The TClass of TList} 
{$ENDC} 
avail ListScanner: TListScanner: {Heads of preallocated Scanner chains} 


availArrayScanner: TArrayScanner 
avail StringScanner: TStringScanner 


{$I FC fTrace} 
fTraceEnabled, fTraceSelf, fTraceClass: BOOLEAN 
{ Current method nesting level } 


tabLevel: INTEGER; 
{ So EP calls don't have to pass a trace level parameter, it is saved here on the corresponding 
BP call. } 
traceLevels: ARRAY [0..trLevMemory] OF I NTEGER; {indexed by tabLevel } 
{ So EP can check for matching BP. } 
traceFrames: ARRAY [0..trLevMemory] OF LONGI NT; {indexed by tabLevel } 


{ To time procedure durations. } 


traceTimes: ARRAY [0..trLevMemory] OF LONGI NT; {indexed by tabLevel } 
{ kpcntr counts number of times AKeyPress has been called and only calls KeyPress every 
keyPresLimit times for performance reasons. } 


kpcntr: INTEGER; 
{ TRUE IF returning to main screen after leaving debugger } 
returnToMai n: BOOLEAN; 


{ traceCount of 0 -> no tracing, traceCount of 1 means you have traced through defTraceCount methods 
so time to enter the debugger. } 
traceCount, defTraceCount: INTEGER 
{ Set with the Level command } 


curTraceLevel: INTEGER 
{ Break when you come to one of these methods } 
breakMethods: ARRAY [1..maxBreaks] OF RECORD 


brClass, brMethod: $8 
END; 
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{ The number of valid break methods currently active } 


breakMCount: INTEGER 
{ TRUE IF showing the debugger prompt } 
showPrompt: BOOLEAN; 
{ TRUE if BP is tallying procedure calls } 
tall yingCalls: BOOLEAN 
{ A hash table if tallyingCalls } 
tallies: THTallies; 
tall yOverhead: LONGI NT; {usual time spent calling and returning from BP, EP, or Tally} *) 
debugTi me: LONGI NT; {cumulative time spend in BP and EP since tallying started} *) 
startTi me: LONGI NT; {when tallying started} 
stopTi me: LONGI NT; {when tallying last paused} 
segNames: TArray{[1..127] OF $8}; 
{ Used to avoid break point checking on methods we have already checked } 
last BpPc: LONGI NT; 
lastEpPc: LONGI NT; 
{$ENDC} 


{$1FC LibraryVersion < 20} 
{So we don't need to use PasLibCall or PPasLibC; this may have to change if those .0OB) files change !!!!} 


PROCEDURE OutputRedirect (VAR errnum: INTEGER; VAR outfile : pathname; stopoutput : 
PROCEDURE DSPaslibCall (VAR ProcParam: dsProcParam); EXTERNAL: 


{$ENDC} 


{We can't USE Unit UDRAW because it USES us} 
PROCEDURE InitErrorAbort(error: INTEGER); EXTERNAL; 
PROCEDURE TrmntExceptionHandler; EXTERNAL; 


{$1 FC fDbgObj ect } 
FUNCTION BindHeap(activeVsClip, doBind: BOOLEAN): THeap; EXTERNAL; 
{$ENDC} 


{We can't USE Unit UDRAW because it USES us} 
PROCEDURE PointToStr(pt: FakePoint; str: TPstring); EXTERNAL; 
PROCEDURE RectToStr(r: FakeRect; str: TPstring); EXTERNAL; 
PROCEDURE LPointToStr(pt: FakeLPoint; str: TPstring); EXTERNAL; 
PROCEDURE LRectToStr(r: FakeLRect; str: TPstring); EXTERNAL; 


{We can't USE Unit Storage because of type name conflicts (Ptr, Handle, ProcPtr) } 


PROCEDURE SetHeap(heap: THeap); EXTERNAL; 
PROCEDURE GetHeap(VAR heap: THeap); EXTERNAL; 
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{We can't USE Unit QuickDraw because we can't use Storage; nor WM without using QuickDraw; nor UDraw, so... 


PROCEDURE I nitQDWM EXTERNAL; {in UDraw} 

PROCEDURE DrawText(textBuf: TpINTEGER; firstByte, byteCount: INTEGER); EXTERNAL; 

FUNCTION TextWidth(textBuf: TpINTEGER; firstByte, byteCount: INTEGER): INTEGER; EXTERNAL; 
PROCEDURE DrawLText(textBuf: TpINTEGER; firstByte, byteCount: INTEGER); EXTERNAL; 


{The rest are assembler routines in XFER and ARE declared in the INTERFACE of this unit} 
FUNCTION LintAndLint(i, j: LONGI NT): LONGINT; EXTERNAL; 
FUNCTION LintOrLInt(i, j: LONGINT): LONGINT; EXTERNAL; 
FUNCTION LintXorLint(i, j: LONGI NT): LONGINT; EXTERNAL; 
PROCEDURE XferLeft(source, dest: Ptr; nBytes: INTEGER); EXTERNAL; 
PROCEDURE XferRight(source, dest: Ptr; nBytes: INTEGER); EXTERNAL; 
FUNCTION Equal Bytes(source, dest: Ptr; nBytes: INTEGER): BOOLEAN; EXTERNAL; 


{The rest are assembler routines in CLASLIB and are NOT declared in the INTERFACE of this unit} 
FUNCTION % GetA5: LONGINT; EXTERNAL; 
PROCEDURE % GoLisabug; EXTERNAL; 


{Forward} 
{$1 FC fDebugMet hods} 
PROCEDURE WriteDRecord(numLevels: INTEGER; hDRecord: Handle; posInDRecord: INTEGER 
PROCEDURE Suppl yFields( PROCEDURE Field(nameAndType: $255))); FORWARD; 
{$ENDC} 


{$$ SgCLAcI d} 
FUNCTION MakeldxArray(numElements: INTEGER; sparse: BOOLEAN): THI dxArray; 
VAR anArray: TArray; 
i: INTEGER; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$1 FC fMaxTrace}EP; {$ENDC} 
IF sparse THEN 
numElements := (((numElements + 6) * 4) DIV 3) 
anArray := TArray.CREATE(NIL, mainHeap, numElements, SI ZEOF(1I NTEGER) ) 
anArray. I nsNullsAt(1, numEl ements); 
MakeldxArray := THI dxArray(anArray); 


( *#e RF 
hArray := THI dxArray(TDynamicArray. CREATE(NIL, mainHeap, SIZEOF(INTEGER), numEl ements) ); 
FOR i := 1 TO numElements DO 


hArray**.records[i] := 0; 
MakeldxArray := hArray; 
*#EKK) 
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000284 END; 

000285 

000286 

000287 {$5 SgCLAcI d} 

000288 PROCEDURE EachObject( heap: THeap; PROCEDURE DoToObj ect(object: TObject)); 


000289 VAR hz: THz; { The heap as a UnitHz type } 

000290 mpFirst: LONGI NT; { The address of the first master pointer } 

000291 mpLast: LONGI NT; { The address of the last master pointer } 

000292 mp! ndex: LONGI NT; { An index variable used for stepping through the master pointers } 
000293 mp: LONGI NT; { the value of the master pointer at mplndex } 

000294 BEGIN 

000295 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000296 {$1 FC fMaxTrace}EP; {$ENDC} 

000297 hz := THz( heap) 

000298 mpFirst := ORD( @hz*. argpPool ) 

000299 mpLast := mpFirst + 4 * ((hz*.ipPoolMac) - 1) 

000300 

000301 {Step through each master pointer in heap} 

000302 mpl ndex := mpFirst; 

000303 WHILE mpl ndex <= mpLast DO 

000304 BEGIN 

000305 mp := ORD( Handl e( mpl ndex) *) 

000306 1F NOT (((mp >= mpFirst) AND (mp <= mpLast)) OR (mp = 1)) THEN {not on the free list} 
000307 DoToObj ect (POI NTER( ORD( mpl ndex))); { Pass it to DoToObject as a TObject, but don't coerce 
000308 directly to a TObject because of run-time checking. } 
000309 mpl ndex := mplndex + 4; { advance to the next master pointer } 

000310 END; 

000311 END; 

000312 

000313 

000314 { Ssssssssssssesssscssssssssssesssssss== HOT UTILITIES =======sssssssssssesssscssssssssscsss= } 
000315 

000316 

000317 

000318 


000319 {$$ sHot Util } 

000320 FUNCTION Min(i, j: LONGINT): LONGI NT; 
000321 BEGIN 

000322 {$1 FC fMaxTrace}BP(1); {$ENDC} 
000323 IF i <j THEN 

000324 Min := i 

000325 ELSE 

000326 Min := j 

000327 {$1 FC fMaxTrace}EP; {$ENDC} 
000328 END; 

000329 

000330 

000331 {$$ sHot Util } 
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000332 FUNCTION Max(i, j: LONGINT): LONGI NT; 
000333 BEGIN 

000334 {$1 FC fMaxTrace}BP(1); {$ENDC} 
000335 1F i > j THEN 

000336 Max := i 

000337 ELSE 

000338 Max := j 

000339 {$1 FC fMaxTrace}EP; {$ENDC} 

000340 END; 

000341 

000342 

000343 {$$ sHot Util } 

000344 PROCEDURE LatestError(newError: INTEGER; VAR previousError: | NTEGER) 
000345 BEGIN 


000346 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000347 IF ((newError > 0) AND (previousError <= 0) OR 
000348 (newError < 0) AND (previousError = 0)) THEN 
000349 previousError := newError 

000350 {$1 FC fMaxTrace}EP; {$ENDC} 

000351 END; 

000352 

000353 


000354 {$8 sHot Util } 
000355 FUNCTION ClassPtr(hndl: Handle): TClass 


000356 VAR stp: RECORD 

000357 CASE INTEGER OF 

000358 1: (asLong: LONGI NT); 
000359 2: (asBytes: PACKED ARRAY [0..3] OF TByte) 
000360 3: (asClass: TClass); 
000361 END; 

000362 BEGIN 

000363 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000364 {$1 FC fMaxTrace}EP; {$ENDC} 

000365 stp.asLong := hndl **; 

000366 stp.asBytes[0] := 0; 

000367 ClassPtr := stp.asClass 

000368 END; 

000369 

000370 


000371 {$8 sUtil} 

000372 PROCEDURE LIntToHex(decNumber: LONGI NT; hexNumber: TPString); 

000373 {NOTE: hexNumber must be >= 8 characters, regardless of size of decNumber} 

000374 

000375 (* This PROCEDURE accepts a binary LONGINT, decNumber, and returns the equivalent hexadecimal *) 

000376 (* number by means of the output parameter hexNumber. Note that if the equivalent hexadecimal number is *) 
000377 (* of a sufficiently small magnitude that it does not require all of the digits in the hex field to be *) 
000378 (* expressed (e.g. if 8 digits are allocated in the hex field and the hex number if 58A7, which is only *) 
000379 (* 4 digits), then the hexadecimal number will be right-justified with leading zeros to pad the field. So, *) 
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(* hexFieldSize. *) 


be returned as 000058A7 if 8 digits are allocated for hexadeci mal 
To change the number of digits in the hex field, change the constant *) 


{NOTE: many users of LlntToHex pass in a pointer to a variable declared as $8; therefore 
that LintToHex not return more than 8 digits } 


CONST 


hexFieldSize = 8; (* the number of digits which are to appear in a hexadecimal field; 


VAR hexDi gits 


ie 
fudge: 
BEGIN 


it is important 


leading zeros 


numbers via the *) 


=] 


(* may be used to pad small hexadecimal numbers (e.g. if hexFieldSize is 8, then the 
(* hex number FA9 would appear as OQOQOFA9) *) 
$16; (* a list which is to contain all hexadecimal digits *) 
1,. hexFiel dSi ze: (* a variable for indexing individual digits of the hex number's field *) 
INTEGER; 


{$1 FC fMaxTrace}BP(1); {$ENDC} 


hexDi gits 


:= '0123456789ABCDEF'; (* Initialize the list of hexadeci mal 


{$R- }hexNumber*[0] := CHR( hexFieldSize); {$I FC fRngObj ect }{$R+}{$ENDC} 


IF decNumber < 0 THEN 


BEGIN 
fudge := 16; {reverse hexDigit indexes} 
decNumber := decNumber + 1; {correct for two's compl ement } 
END 

ELSE 
fudge := 1; 

FOR i := hexFieldSize DOWNTO 1 DO 
BEGIN 


hexNumber*[i] := hexDigits[(decNumber MOD 16) + fudge] 
decNumber := decNumber DIV 16 


END; 


{$1 FC fMaxTrace}EP; {$ENDC} 
END; (* LintToHex *) 


{$5 sUtil} 


PROCEDURE Li ntToStr(decNumber: LONGINT; str: TPString); 


{NOTE 
VAR neg : 

pos : 
BEGI N 


str must be >= 11 characters, regardless of size of number} 
BOOLEAN; 
INTEGER; 


{$I FC fMaxTrace}BP( 1); {$ENDC} 
{$R-} str*[O] := CHR(11); {$IFC fRngObject} {$R+} {$ENDC} 


pos : 
neg : 


11; 
(decNumber < 0); 
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000428 decNumber := ABS (decNumber); 
000429 

000430 REPEAT 

000431 str“[pos] := CHR(ORD('0') + (decNumber MOD 10)) 
000432 pos := pos - 1; 

000433 decNumber := decNumber DIV 10 
000434 UNTIL decNumber = 0; 

000435 

000436 IF neg THEN 

000437 BEGIN 

000438 str“[pos] := '+'; 

000439 pos := pos - 1; 

000440 END; 

000441 

000442 DELETE (str%, 1, pos) 

000443 {$1 FC fMaxTrace}EP; {$ENDC} 

000444 END; 

000445 

000446 


000447 {$8 sUtil } 
000448 PROCEDURE IntToStr(decNumber: INTEGER; str: TPString); 


000449 {NOTE: str must be >= 6 characters (sign + 5 digits), regardless of size of decNumber} 
000450 VAR sll: STRI NG[ 11] 

000451 BEGIN 

000452 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000453 Li ntToStr(decNumber, @s11); 

000454 XferLeft(Ptr(@s11), Ptr(str), Length(s11) + 1); { str length + 1 size byte } 

000455 {$1 FC fMaxTrace}EP; {$ENDC} 

000456 END; 

000457 

000458 


000459 {$8 sUtil} 

000460 PROCEDURE HexStrToLInt(hexString: TPString; VAR decNumber: LONGINT; VAR result: TConvResult); 

000461 

000462 (* This PROCEDURE accepts a STRING of hexadecimal digits, hexString, and returns a long-INTEGER decimal *) 


000463 (* equivalent by means of the variable parameter decNumber. Information concerning the acceptability of *) 
000464 (* the hexadecimal STRING is returned via the variable parameter result. a 
000465 (* Note that this PROCEDURE ignores any leading or trailing blanks which may be present in the given *) 
000466 (* hexString, and the presence of lower-case hexadecimal digits in the hex STRING does not adversely *) 
000467 (* affect conversion. Also, if the first non-blank character of the STRING is a dollar sign, then that *) 
000468 (* dollar sign is ignored and not considered during conversion (it is, effectively, deleted fromthe *) 
000469 (* STRING). *) 
000470 

000471 VAR numDigits: 0..255; (* The number of digits in the hex STRING *) 

000472 digit: CHAR; 

000473 i: INTEGER; (* index variable *) 

000474 digitValue: INTEGER; (* index variable *) 

000475 hexDigits: $16; (* an array which is to contain a list of hexadecimal digits *) 
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000476 
000477 
000478 
000479 
000480 
000481 
000482 
000483 
000484 
000485 
000486 
000487 
000488 
000489 
000490 
000491 
000492 
000493 
000494 
000495 
000496 
000497 
000498 
000499 
000500 
000501 
000502 
000503 
000504 
000505 
000506 
000507 
000508 
000509 
000510 
000511 
000512 
000513 
000514 
000515 
000516 
000517 
000518 
000519 
000520 
000521 
000522 
000523 
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BEGIN (* HexStrToLint *) 
{$1 FC fMaxTrace}BP(1); {$ENDC} 


(* Delete any trailing blanks *) 
Tri mBl anks( POI NTER( ORD( hexstring))); 


{ Remove any leading zeros, except keep at least 1 digit; also, remove any leading $ } 


IF Length(hexString*) > 0 THEN 


WHILE ((Length(hexString*) > 1) AND (hexString*[1] = '0')) OR (hexString*[1] = '$') DO 


Delete(hexString*, 1, 1); 
numDi gits := Length(hexString*); 
decNumber := 0; 


IF numDigits = 0 THEN (* if the given hex STRING is empty... *) 


result := cvNoNumber 
ELSE 
IF Length (hexString*) > 8 THEN (* if can't fit in LONGINT *) 
result := cvOverfl ow 
ELSE 
result := cvValid; (* innocent until proven guilty *) 
FOR i := 1 TO numDigits DO 
BEGIN 


digit := hexString*[i] 
IF digit IN ['0'..'9'] THEN 
digitValue := ORD( digit) - ORD('0') 
ELSE 
IF digit IN ['A'..'F'] THEN 
digitValue := ORD( digit) - ORD('A') + 10 
ELSE 
IF digit IN ['a'..'f'] THEN 
digitValue := ORD( digit) - ORD('a') + 10 


ELSE 

BEGIN 

digitValue := 0; 

result := cvBadNumber 

END; 
decNumber := decNumber * 16 + digitValue 
END; 


{$I FC fMaxTrace}EP; {$ENDC} 
END; (* HexStrToLint *) 


{$8 sUtil} 
PROCEDURE StrToLint(str: TPString; VAR decNumber: LONGINT; VAR result: TConvResult); 
LABEL 1; 
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000524 

000525 VAR s: $255: 

000526 pos: I NTEGER; 

000527 neg: BOOLEAN; 

000528 BEGIN 

000529 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000530 result := cvValid; 

000531 XferLeft(Ptr(str), Ptr(@s), Length(str*) + 1); 
000532 Tri mBl anks( @s); 

000533 

000534 decNumber := 0; 

000535 neg := FALSE; 

000536 

000537 IF s='' THEN 

000538 result := cvNoNumber 

000539 ELSE IF (s[1]='-') OR (s[l]='+') THEN 
000540 BEGIN 

000541 neg := s[1] ='-'; 

000542 Delete(s, 1, 1); 

000543 1F s='' THEN 

000544 result := cvBadNumber: 

000545 END; 

000546 

000547 pos := 1; 

000548 WHILE pos <= Length(s) DO 

000549 BEGIN 

000550 1F ('0' > s[pos]) OR (s[pos] > '9') THEN {invalid numeric character} 
000551 BEGIN 

000552 result := cvBadNumber: 

000553 GOTO 1; 

000554 END; 

000555 

000556 {check for overfl ow} 

000557 IF pos > 10 THEN {more than 10 digits guarantees an overfl ow} 
000558 BEGIN 

000559 result := cvOverfl ow; 

000560 GOTO 1; 

000561 END; 

000562 1F pos = 10 THEN 

000563 IF ORD(s[pos]) > ORD('7') THEN 
000564 1F decNumber > 214748363 THEN 
000565 BEGIN 

000566 result := cvOverflow; 
000567 GOTO 1; 

000568 END 

000569 ELSE 

000570 { okay } 

000571 ELSE { 10th digit is 7 or less } 
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000572 
000573 
000574 
000575 
000576 
000577 
000578 
000579 
000580 
000581 
000582 
000583 
000584 
000585 
000586 
000587 
000588 
000589 
000590 
000591 
000592 
000593 
000594 
000595 
000596 
000597 
000598 
000599 
000600 
000601 
000602 
000603 
000604 
000605 
000606 
000607 
000608 
000609 
000610 
000611 
000612 
000613 
000614 
000615 
000616 
000617 
000618 
000619 
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1F decNumber > 214748364 THEN 
BEGIN 
result := cvOverflow 
GOTO 1; 
END; 
decNumber := (10 * decNumber) + (ORD(s[pos]) - ORD('0')); 
pos := pos + 1; 
END; 
IF neg THEN 
decNumber : = -decNumber 
1: 
{$1 FC fMaxTrace}EP; {$ENDC} 
END; 
{$$ sUtil } 
PROCEDURE StrTolnt(str: TPString; VAR decNumber: INTEGER; VAR result: TConvResult); 


VAR |: LONGI NT; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$1 FC fDbgObj ect} 
{$0V+} {make sure we don't screw up} 
{$ENDC} 
StrToLint(str, |, result); 
IF result = cvValid THEN 
IF (| < -MAXINT-1) OR (1 > MAXINT) THEN 
result := cvOverflow 
ELSE 
decNumber := I NTEGER(I); 
{$1 FC fMaxTrace}EP; {$ENDC} 
END; 


{$$ sUtil } 
PROCEDURE TrimBlanks(str: TPString); 
LABEL 
1, 10; 


CONST 
tabCh = CHR(9); 


VAR i: | NTEGER; 


BEGIN 
{$lFC f MaxTrace}BP( 1); {$ENDC} 
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000620 WHILE i <= Length(str*) DO 
000621 BEGIN 

000622 IF str*[i] <> ' ' THEN 
000623 IF str*[i] <> tabCh THEN 
000624 BEGIN {delete all the leading stuff we have found} 
000625 Delete(str*, 1, i-1) 
000626 GOTO 1; 

000627 END; 

000628 isei¢+dl 

000629 END; 

000630 

000631 { we fell thru -- either '' or all blanks or tabs } 
000632 str herr 

000633 GOTO 10; 

000634 

000635 1: {now trimthe trailing blanks} 
000636 

000637 i := Length(str%) 

000638 WHILE i > 0 DO 

000639 BEGIN 

000640 IF (str*[i] = ' ') OR (str*[i] = tabCh) THEN 
000641 Delete(str*, i, 1) 
000642 ELSE 

000643 GOTO 10; 

000644 itsi- 1; 

000645 END; 

000646 10: 

000647 {$1 FC fMaxTrace}EP; {$ENDC} 
000648 END; 

000649 

000650 


000651 {$S sUtil } 
000652 FUNCTION CharUpperCased(ch: CHAR): CHAR; 
000653 BEGIN 


000654 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000655 CharUpperCased := ch; 

000656 IF 'a' <= ch THEN 

000657 IF ch <= 'z' THEN 

000658 CharUpperCased := CHR(ORD(ch) - 32) 
000659 {$1 FC fMaxTrace}EP; {$ENDC} 

000660 END; 

000661 

000662 


000663 {$S sUtil} 
000664 PROCEDURE StrUpperCase(str: TPString); 


000665 VAR i: INTEGER 
000666 BEGIN 
000667 {$1 FC fMaxTrace}BP(1); {$ENDC} 
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000668 
000669 
000670 
000671 
000672 
000673 
000674 
000675 
000676 
000677 
000678 
000679 
000680 
000681 
000682 
000683 
000684 
000685 
000686 
000687 
000688 
000689 
000690 
000691 
000692 
000693 
000694 
000695 
000696 
000697 
000698 
000699 
000700 
000701 
000702 
000703 
000704 
000705 
000706 
000707 
000708 
000709 
000710 
000711 
000712 
000713 
000714 
000715 
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i := Length(str%); 
WHILE i > 0 DO 
BEGIN 
str“*[i] := CharUpperCased(str“[i]); 
i:si- 1; 
END; 
{$1 FC fMaxTrace}EP; {$ENDC} 
END; 
{$$ sUtil } 
PROCEDURE SplitFilePath( VAR full Path, itsCatalog, itsFilePart: TFilePath); 
LABEL 1; 
VAR i: INTEGER 
BEGIN 
{$l FC FMaxTrace}BP( 1); {$ENDC} 
itsCatalog := 
itsFilePart := full Path; 
FOR i := Length(itsFilePart) DOWNTO 1 DO 
IF itsFilePart[i] = '-' THEN 
BEGIN 
itsCatalog := COPY(itsFilePart, 1, i); 
DELETE(itsFilePart, 1, i); 
GOTO 1; 
END; 
1: 
{$1 FC fMaxTrace}EP; {$ENDC} 
{$$ sStartup} 


PROCEDURE SetCp(object: TObject; itsClass: TClass); 
VAR index: INTEGER 


BEGIN 

{$1 FC fMaxTrace}BP(1); {$ENDC} 

Handl e(obj ect) ** := ORD(itsClass); {Install slice table pointer} 

index := CiOfCp(TPSliceTable(itsClass)); {Determine its class index} 

IF index < 256 THEN {If it will fit in a byte, store it.. 
{$R-} TPByte(Handle(obj ect) *)* := index; {...to speed version conversion (cf Convert Heap: Fi ndCl asses) } 
{$1 FC fRngObj ect} {$R+}{$ENDC} 


{$I FC fMaxTrace}EP; {$ENDC} 
END; 


{$$ sStartup} 
FUNCTION NewDynObject(heap: THeap; itsClass: TClass; dynBytes: INTEGER): TObject 
VAR nBytes: INTEGER 
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000716 object: TObj ect; 

000717 BEGIN 

000718 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000719 nBytes := SizeOfCp(TPSliceTable(itsClass)) + dynBytes; 

000720 object := POINTER(ORD( HAI | ocate(THz(heap), nBytes))); {TObject() won't work until after SetCp} 
000721 1F ORD(object) = ORD(hNIL) THEN 

000722 BEGIN 

000723 {$l FC fDbgObj ect } 

000724 WriteLn(CbOfHz(THz(heap)):1, ' bytes in the heap'); 

000725 {$ENDC} 

000726 ABCBreak('NewObj ect: Heap full, can''t make an object of size', nBytes) 
000727 END; 

000728 SetCp(object, itsClass); 

000729 NewDynObj ect := object; 

000730 {$1 FC fMaxTrace}EP; {$ENDC} 

000731 END; 

000732 

000733 


000734 {$8 sStartup} 
000735 FUNCTION NewObject(heap: THeap; itsClass: TClass): TObject; 
000736 BEGIN 


000737 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000738 NewObj ect := NewDynObject(heap, itsClass, 0) 
000739 {$1 FC fMaxTrace}EP; {$ENDC} 

000740 END; 

000741 

000742 


000743 {$8 sStartup} 
000744 PROCEDURE ResizeDynObject(object: TObject; newTotal Bytes: INTEGER); 


000745 VAR i: INTEGER 

000746 BEGIN 

000747 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000748 IF (newTotal Bytes < 0) OR (newTotal Bytes > ( MAXINT-20)) THEN 

000749 ABCBreak('New size must lie between 0 and 32K-20, not', newTotal Bytes); 
000750 ChangeSi zeH(THz(object. Heap), TH(object), newTotal Bytes); 

000751 IF ChDataOfH(THz(object.Heap), TH(object)) < newTotal Bytes THEN 

000752 ABCBreak('ResizeDynObj ect: Heap full, size can''t change to', newTotal Bytes); 
000753 {$1 FC fMaxTrace}EP; {$ENDC} 

000754 END; 

000755 

000756 


000757 {$1FC compati bileLists} 
000758 FUNCTION SubObject(super: TObject; itsClass: TClass): TObject; 
000759 BEGIN 


000760 ResizeDynObject(super, SizeOfCp(TPSliceTable(itsClass))); 
000761 SetCP(super, itsClass); 

000762 SubObj ect := super; 

000763 END; 
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000764 
000765 
000766 
000767 
000768 
000769 
000770 
000771 
000772 
000773 
000774 
000775 
000776 
000777 
000778 
000779 
000780 
000781 
000782 
000783 
000784 
000785 
000786 
000787 
000788 
000789 
000790 
000791 
000792 
000793 
000794 
000795 
000796 
000797 
000798 
000799 
000800 
000801 
000802 
000803 
000804 
000805 
000806 
000807 
000808 
000809 
000810 
000811 
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{$$ sStartup} 


FUNCTI ON 
BEGIN 


NewOrRecycledObj ect(heap: THeap; itsClass: TClass; VAR chainHead: TObject): TObject 


{$1 FC fMaxTrace}BP(1); {$ENDC} 
1F chainHead = NIL THEN 


ELS 


NewOrRecycledObject := NewObject(heap, itsClass) 
E 


BEGIN 

{$1 FC fDbgObj ect} 

IF (chainHead.Class <> itsClass) OR (chainHead. Heap <> heap) THEN 
ABCBreak('NewOrRecycledObject: chainHead contains an alien object', ORD(chai nHead) ) 

{$ENDC} 

NewOrRecycledObject := chainHead 

chainHead := THRecycl eChai n( chai nHead) **. chai nLi nk; 


END; 
{$I FC fMaxTrace}EP; {$ENDC} 


END; 


{$$ sStartup} 

PROCEDURE RecycleObject(object: TObject; VAR chainHead: TObject); 
{$1 FC fDbgObj ect } 
VAR chainMember: TObj ect 
{$ENDC} 


BEGIN 


{$I FC fMaxTrace}BP( 1); {$ENDC} 
{$1 FC fDbgObj ect } 
IF object. HeapBytes < 8 THEN 


ABCBreak('RecycleObject: object is too small for a chainHead link', ORD(object)); 


chainMember := chainHead 
WHILE chainMember <> NIL DO 


BEGIN 
1F chainMember = object THEN 
ABCBreak('RecycleObject: object freed twice', ORD(object)); 
chainMember : = THRecycl eChai n(chainMember) **. chai nLink 
END; 


{$ENDC} 

THRecycl eChai n(obj ect) **. chainlink := chainHead 
chainHead := object; 

{$1 FC fMaxTrace}EP; {$ENDC} 


END; 


{$8 sRes} 
PROCEDURE Recreate(object: TObject; oldSize, newSize: INTEGER; newSTP: TPSliceTable); 
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000812 VAR extraPtr: TPByte 

000813 hz: THz; 

000814 cb: INTEGER; 

000815 bk: LONGI NT 

000816 BEGIN 

000817 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000818 SetCP( object, TClass(newSTP)); {Install the new slice-table pointer} 
000819 1F newSize <> oldSize THEN {Default extra fields to 0/ NIL} 

000820 BEGIN 

000821 hz := HzFromH(TH(object)); 

000822 ch := ChDataOfH(hz, TH(object)); 

000823 bk := ORD( Handl e( obj ect) *); 

000824 

000825 IF (cb > oldSize) AND (newSize < oldSize) THEN {There is a variable-length part & we're shrinking} 
000826 XferLeft(Ptr(bk + oldSize), Ptr( bk + newSize), ch - ol dSize) 

000827 

000828 ChangeSizeH(hz, TH(object), ch + newSize - oldSize) 

000829 

000830 IF (cb > oldSize) AND (newSize > oldSize) THEN {There is a variable-length part & we're expanding} 
000831 XferRight(Ptr(bk + oldSize), Ptr(bk + newSize), ch - oldSize) 

000832 

000833 IF newSize > oldSize THEN {Default extra fields to 0/ NIL} 

000834 BEGIN 

000835 extraPtr := TPByte(bk + oldSize + 1) 

000836 extraPtr* := 0; {Store one zero and let XferLeft copy it repeatedly} 
000837 XferLeft(Ptr(extraPtr), Ptr(ORD(extraPtr) + 1), newSize - oldSize - 1) 
000838 END; 

000839 END; 

000840 {$1 FC fMaxTrace}EP; {$ENDC} 

000841 END; 

000842 

000843 


000844 {$8 sRes} 
000845 FUNCTION Superclass(class: TClass): TClass 
000846 BEGIN 


000847 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000848 {$R-} Superclass := TClass(TPSliceTable(class)*[-1]); {$IFC fRngObj ect }{$R+}{$ENDC} 
000849 {$1 FC fMaxTrace}EP; {$ENDC} 

000850 END; 

000851 

000852 


000853 {$$ sRes} 
000854 FUNCTION ClassDescendsFrom( descendant, ancestor: TClass): BOOLEAN 
000855 BEGIN 


000856 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000857 WHILE (descendant <> ancestor) AND (descendant <> NIL) DO 

000858 {$R-} descendant := TClass(TPSliceTable(descendant) *[-1]); {$lFC fRngObj ect }{$R+}{$ENDC} 
000859 ClassDescendsFrom:= descendant <> NIL; 
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000860 
000861 
000862 
000863 
000864 
000865 
000866 
000867 
000868 
000869 
000870 
000871 
000872 
000873 
000874 
000875 
000876 
000877 
000878 
000879 
000880 
000881 
000882 
000883 
000884 
000885 
000886 
000887 
000888 
000889 
000890 
000891 
000892 
000893 
000894 
000895 
000896 
000897 
000898 
000899 
000900 
000901 
000902 
000903 
000904 
000905 
000906 
000907 
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{$I FC fMaxTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
PROCEDURE NameOfClass(class: TClass; VAR className: TCl assName); 
BEGIN 
{$I FC fMaxTrace}BP( 1); {$ENDC} 
CpToCn(TPSliceTable(class), TS8(className) ) 
{$I FC fMaxTrace}EP; {$ENDC} 
END; 


{$$ sRes} 
FUNCTION SizeOfClass(class: TClass): INTEGER 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
SizeOfClass := SizeOfCp(TPSliceTabl e(class)); 
{$1 FC fMaxTrace}EP; {$ENDC} 
END; 


{$$ SgCLAres} 
{tolnsert, return: -1 if class already there or if table full, index if a hole found} 
{not tolnsert, return: index (> 0) if class found, -1 if not there} 

FUNCTION LookupName(classAl pha: TA8; tolnsert: BOOLEAN): INTEGER 


FUNCTION CompareName(hashindex: INTEGER): THashCompare 
VAR my! ndex: INTEGER 
trialName: TS8; 
BEGIN 
my! ndex := hMyHashName**, records[ hashl ndex] 
1F mylndex = 0 THEN 
CompareName := cHole 
ELSE 
IF classAl pha = hMyClasses**.records[ myl ndex].classAl pha THEN 
CompareName := cMatch 
ELSE 
CompareName : = cMismatch; 
END; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$1 FC fMaxTrace}EP; {$ENDC} 
LookupName := LookupI nHashArray(hMyHashName**. header.size 
ORD(cl assAl pha[ 2])*ORD( cl assAl pha[4]) +ORD(cl assAl pha[6]), 
tolnsert, CompareName) 
END; 
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000908 

000909 

000910 {$8 SgCLAres} 

000911 FUNCTION ValidDataAddress(addr: LONGI NT): BOOLEAN 


000912 {Returns TRUE iff: addr is in a data segment (stack seg doesn't qualify) 
000913 AND is it an even address 

000914 AND is it within the bounds of the data segment } 
000915 

000916 CONST dsMaxSize = $00020000; {128K} 

000917 

000918 VAR error: INTEGER 

000919 refnum: INTEGER 

000920 dsinfo: dsinfoRec 

000921 BEGIN 

000922 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000923 ValidDataAddress := FALSE; 

000924 

000925 1F NOT ODD(addr) THEN 

000926 BEGIN 

000927 Info Address(error, addr, refnum) 

000928 IF error <= 0 THEN 

000929 BEGIN 

000930 Info Dataseg(error, refnum, dsinfo) 

000931 IF error <= 0 THEN 

000932 1F (addr MOD dsMaxSize) < dsinfo. mem size THEN 
000933 ValidDataAddress := TRUE; 

000934 END; 

000935 END; 

000936 {$1 FC fMaxTrace}EP; {$ENDC} 

000937 END; 

000938 

000939 


000940 {$8 sStartup} 
000941 PROCEDURE Free(object: TObj ect); 
000942 BEGIN 


000943 {$1 FC fMaxTrace}BP(1); {$ENDC} 

000944 IF object <> NIL THEN 

000945 object. Free; 

000946 {$1 FC fMaxTrace}EP; {$ENDC} 

000947 END; 

000948 

000949 

000950 {*** THE FOLLOW NG TWO ROUTINES ASSUME THAT THE hHashName AND hMyClasses TABLES ARE ALWAYS AROUND ***} 
000951 {*** |F THEY START SWAPPING OUT, WRITE LINEAR SEARCH ROUTINES TO REPLACE THESE ***} 
000952 

000953 

000954 {$8 SgCLAres} 

000955 FUNCTION CiOfAl pha(classAl pha: TA8): INTEGER; {convert class title TA8 to class index} 
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000956 
000957 
000958 
000959 
000960 
000961 
000962 
000963 
000964 
000965 
000966 
000967 
000968 
000969 
000970 
000971 
000972 
000973 
000974 
000975 
000976 
000977 
000978 
000979 
000980 
000981 
000982 
000983 
000984 
000985 
000986 
000987 
000988 
000989 
000990 
000991 
000992 
000993 
000994 
000995 
000996 
000997 
000998 
000999 
001000 
001001 
001002 
001003 
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VAR hashindex: INTEGER 
i: INTEGER; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
hashil ndex := LookupName(classAl pha, FALSE); 
IF hashlndex <= 0 THEN 
Ci Of Alpha := 0 
ELSE 
Ci Of Alpha := hMyHashName**. records[hashli ndex] 
{$1 FC fMaxTrace}EP; {$ENDC} 
END; 


{$$ SgCLAres} 


FUNCTION CiOfCn(className: $8): INTEGER; {convert upper-case class title $8 to class index} 
VAR a8: TA8; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
FillChar(a8, 8, ' '); 
XferLeft(Ptr( ORD( @className) +1), @a8, Length(className) ); 
Ci Of Cn : = Ci Of Al pha( a8); 
{$1 FC fMaxTrace}EP; {$ENDC} 
END; 
{ SPSSSsssscsssssssssssssssssssssssssssscs | NITILALI ZATION s2essscssssssssssssssssssssssssssssses } 
{$$ sError} 


PROCEDURE CheckI nitError(error: INTEGER); 
BEGIN 
{$I FC fMaxTrace}BP( 1); {$ENDC} 


IF error > 0 THEN {Can only call with error > 0 before TProcess class-init has run} 
InitErrorAbort(error); 
{$1 FC fMaxTrace}EP; {$ENDC} 
END; 
{$$ slnit1} 
FUNCTION NewHeap(VAR error: INTEGER; heapStart, numBytes: LONGINT; numObjects: INTEGER): THeap; 
VAR heap: THeap; 
BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
heap := THeap(Hzil nit(POINTER(heapStart), POINTER( heapStart +numBytes), 
NIL, numObjects, 0, POINTER(procNil) 
POINTER(procNil), POINTER(procNil), POINTER(procNil))); 
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001004 1F heap = POINTER(1) THEN 
001005 BEGIN 

001006 error := erlnternal 
001007 ABCBreak('NewHeap could not make a heap of size', numBytes) 
001008 heap := NIL; 

001009 END 

001010 ELSE 

001011 error := 0; 

001012 

001013 NewHeap := heap; 

001014 {$1 FC fMaxTrace}EP; {$ENDC} 
001015 END; 

001016 

001017 


001018 {$8 slnit1} 
001019 FUNCTION MakeDataSegment(VAR error, dsRefnum: INTEGER; firstTryVolume, thenTryVolume: TFil ePath; 


001020 Idsn, memBytes, diskBytes: INTEGER): LONGI NT 
001021 VAR startAddress: LONGINT; 

001022 

001023 PROCEDURE TryMakeDataSegment(volumePart: TFilePath); 
001024 VAR dsPathname: PathName 

001025 BEGIN 

001026 dsPathname := Concat(volumePart, ‘ds_private') 
001027 Make Dataseg(error, dsPathname, memBytes, diskBytes, dsRefnum, startAddress, Idsn, ds_private) 
001028 END; 

001029 

001030 BEGIN 

001031 {$1 FC fMaxTrace}BP(1); {$ENDC} 

001032 TryMakeDat aSegment(firstTryVol ume) ; 

001033 IF error = 309 THEN 

001034 1F firstTryVolume <> thenTryVol ume THEN 

001035 TryMakeDataSegment(thenTryVol ume) 

001036 

001037 IF error >0 THEN 

001038 BEGIN 

001039 ABCBreak(' MakeDataSegment', error) 

001040 startAddress := 0 

001041 END; 

001042 MakeDataSegment := startAddress 

001043 {$1 FC fMaxTrace}EP; {$ENDC} 

001044 END; 

001045 

001046 


001047 {$8 slnit1} 
001048 PROCEDURE Init Obj ect; 


001049 VAR dsp: DsProcParam 
001050 excepName: T_Ex_Name 
001051 error: INTEGER; 
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001052 
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001096 
001097 
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001099 
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presinfo: Proci nf oRec; 
heapBase: LONGI NT; 
progVol ume: Pat hName 


BEGIN 


{Until we call Imi tQDWM, NOTHING CAN FAIL!!!!} 


islnitialized := FALSE; 
amDying := FALSE; 
wml sl nitialized := FALSE; 


{An interface variable set true at a higher level: e.g., by TProcess. Run} 
{An interface variable set true at a higher level when I mDying is called} 
{An interface variable set true at a higher level: e.g., by Init QDWM} 


{$l FC fTrace} 
fTraceEnabled := FALSE: 

f DebugRecursion := FALSE; 
tabLevel := -1; 
curTraceLevel := 1: 
traceCount := 0; 
defTraceCount := 
breakMCount := 0 
kpcentr := 0; 
keyPresLimit := stdKeyPresLimit; 
returnToMain := TRUE; 
showPrompt := TRUE; 
outputindent := 0 
currXPos := 0; 
tallyingCalls := FALSE; 
tallies := NIL; 
segNames := NIL; 
{$ENDC} 


0; 


{Determine environment and program volume name} 


Info Process(error, My_id, presinfo); 


{get my volume name as '-volname-'; assumes that the OS gives us back a program name of the form 
'-vol name- progname' } 

Delete(prcsinfo. progPathName, 1, 1); {the first '-'} 

progVolume := Concat('-', Copy(prcesinfo.progPathName, 1, Pos('-', presInfo. progPat hName) )); 


{$1FC LibraryVersion <= 20} 
{Yu Ying has a better way to know if we are on the desktop or in the workshop, but meanwhile... } 


IF presinfo.father_Id > 1 THEN 
BEGIN 
Info Process(error, presinfo.father_Id, presinfo); 


{this assumes that the OS returns a program name of the form'-volname- progname' } 
Delete(prcsinfo. progPathName, 1, 1); {the first '-'} 

Delete(prcsinfo. progPathName, 1, Pos('-', presinfo.progPathName)); {the ‘vol name-' } 
StrUpperCased( @prcsinfo. progPat hName) ; 
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001100 

001101 onDesktop := prcsinfo. progPathName = 'SHELL. OFFICE SYSTEM ; 
001102 END 

001103 ELSE 

001104 BEGIN 

001105 onDesktop := FALSE; 

001106 END; 

001107 {$ELSEC} 

001108 dsp. procCode := dsGet Di skEnbF; 

001109 DSPaslibCall (dsp); 

001110 onDesktop := NOT dsp. diskEnbF; 

001111 {$ENDC} 

001112 

001113 Ini t QDWM; {must be the first thing before any operations that could fail 
001114 when running on the Workshop, it also sets up the FontMgr & writeln to alternate screen. } 
001115 

001116 {$1 FC fDbgObj ect } 

001117 Write('Running on the '); 

001118 IF onDesktop THEN 

001119 WriteLn('desktop' ) 

001120 ELSE 

001121 WriteLn('workshop'); 

001122 {$ENDC} 

001123 

001124 {Declare an OS Exception Handler} 

001125 excepName := 'SYS_ TERMI NATE’ 

001126 Declare Excep_Hdl (error, excepName, @TrmntExcepti onHandl er); 

001127 Checkil nitError(error); 

001128 

001129 {$1 FC fDbgObj ect} 

001130 GoToXY(0, 31); 

001131 {$ENDC} 

001132 

001133 {Create data segment and heap} 

001134 mainLdsn := presLdsn; 

001135 heapBase := MakeDataSegment(error, mainDsRefnum, '', progVolume, mainldsn, prcsDsBytes, prcsDsBytes); 
001136 CheckIl nitError(error); 

001137 

001138 mainHeap := NewHeap(error, heapBase, prcsDsBytes, prcsDsBytes DIV 20) 
001139 Checkl nitError(error); 

001140 

001141 Set Heap( mai nHeap) 

001142 END; 

001143 

001144 

001145 {$8 sIlnit1} 

001146 PROCEDURE UnitAuthor(companyAndAuthor: TAuthorName) ; {required once per unit} 
001147 VAR a32: TA32; 
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001148 BEGIN 


001149 StrUpperCased( @companyAndAut hor); 

001150 Fill Char(a32, 32, ' '); 

001151 XferLeft(Ptr( ORD( @companyAndAut hor) +2), @a32, LENGTH(companyAndAuthor)); 
001152 QUni t Aut hor(a32); 

001153 END; 

001154 

001155 

001156 {$$ slnit1} 

001157 PROCEDURE ClassAuthor(companyAndAuthor: TAuthorName; classAlias: TCl assName); {optional } 
001158 VAR a32: TA32: 

001159 as: TAB: 

001160 BEGIN 

001161 1F LENGTH( companyAndAuthor) > 0 THEN 

001162 BEGIN 

001163 StrUpperCased( @companyAndAut hor); 

001164 FillChar(a32, 32, ' '); 

001165 XferLeft(Ptr(ORD( @companyAndAuthor) +1), @a32, LENGTH( companyAndAut hor) ) 
001166 QCl ass Aut hor(a32) 

001167 END; 

001168 

001169 IF LENGTH(classAlias) > 0 THEN 

001170 BEGIN 

001171 StrUpperCased(@cl assAlias); 

001172 FillChar(a8, 8, ' ; 

001173 XferLeft(Ptr( ORD( @classAlias) +1), @a8, LENGTH(classAlias)); 

001174 QCl assAlias(a8); 

001175 END; 

001176 END; 

001177 

001178 

001179 {$$ slnit1} 

001180 PROCEDURE ClassVersion(itsVersion, oldestIltCanRead: Byte); {optional } 
001181 BEGIN 

001182 IF (itsVersion < 0) OR (itsVersion > 127) OR (oldestIitCanRead < 0) OR (oldestitCanRead > 127) OR 
001183 (oldestitCanRead > itsVersion) THEN 

001184 ABCBreak('Version numbers must be in the range 0..127 and oldestitCanRead <= itsVersion' 
001185 itsVersion); 

001186 QClassVersion(itsVersion, oldestitCanRead); 

001187 END; 

001188 

001189 

001190 { Sssssssssssssssssessssssssssssssssss== VERSION CONVERSION =======s=s=ssssssssessssesssscsssscssz= } 
001191 

001192 


001193 {$8 SgCLAcI d} 
001194 PROCEDURE ConvClass(object: TObject; exWorld: TWorld; exlndex, mylndex: INTEGER); 
001195 BEGIN 
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001196 {$1 FC fMaxTrace}BP(1); {$ENDC} 

001197 Recreate(object, exWorld. hExClasses**. records[exlndex].objectSize, (***) 

001198 hMyClasses**. records[ myl ndex].objectSize, hMySTables**.records[ myl ndex]); (***) 
001199 {$1 FC fMaxTrace}EP; {$ENDC} 

001200 END; 

001201 

001202 


001203 {$8 SgCLAclI d} 
001204 FUNCTION IndexOfExClass(exWorld: TWorld; exindex: INTEGER): INTEGER 


001205 LABEL 1, 2; 

001206 VAR exAuthor: TA32: 

001207 exAlias: TA8: 

001208 exAl pha: TA8: 

001209 coCode: INTEGER; 

001210 al Code: INTEGER; 

001211 index: INTEGER; 

001212 BEGIN 

001213 {$1 FC fMaxTrace}BP(1); {$ENDC} 

001214 {$1 FC fMaxTrace}EP; {$ENDC} 

001215 IndexOfExClass := 0; 

001216 

001217 WTH exWorld, hExClasses**. records[exI ndex] DO (***)(* WHOLE BLOCK CHANGED *) 
001218 BEGIN 

001219 exAl pha := classAl pha; 

001220 

001221 IF classAlias = 0 THEN 

001222 exAlias := classAl pha 

001223 ELSE 

001224 exAlias := hExAliases**.records[classAlias] 
001225 

001226 1F companyAndAuthor <> 0 THEN 

001227 BEGIN 

001228 exAuthor := hExAuthors**. records[ companyAndAut hor]; 
001229 WITH hMyAuthors** DO 

001230 FOR coCode := 1 TO numAuthors DO 

001231 IF records[coCode] = exAuthor THEN (***) 
001232 GOTO 1; 

001233 END; 

001234 coCode := 0; 

001235 1: 

001236 END; 

001237 

001238 {If that class name is in my alias list, do it the hard way} 
001239 WTH hMyAliases** DO 

001240 FOR alCode := 1 TO numAliases DO 

001241 IF records[alCode] = exAlias THEN 

001242 GOTO 2: 

001243 
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{If that class name is one of mine, too, do it the easy way} 
index := Ci Of Al pha(exAl pha); 
IF index <> 0 THEN (***) 
IF hMyClasses**.records[index].companyAndAuthor = coCode THEN 
BEGIN (***) 
IndexOfExClass := index; 
EXIT( I ndexOfExClass); (***) 
END; (***) 


{Different company name or never heard of that class name at all, return 0} 
EXIT(IndexOfExClass); (***) 


{The hard way: exhaustive search, because we may be using different names for the same class} 
WTH hMyClasses** DO 
FOR index := 1 TO numClasses DO 
WITH records[index] DO 
1F coCode = companyAndAuthor THEN 
IF alCode = classAlias THEN 


BEGIN 

IndexOfExClass := index; 
EX! T(I ndexOfExClass); 
END; 


END; 


{$$ SgCLAcl d} 
FUNCTION NeedConversion(exClassWorld: TClassWorld; VAR olderVersion, newerVersion: BOOLEAN): BOOLEAN: 


VAR someDifference: BOOLEAN; 
exWorl d: TWorld: 
numExCl asses: INTEGER; 
exi ndex: INTEGER; 
exi nfo: TClassinfo; 
exSize: INTEGER; 
exSTP: TPSliceTable; 
myl ndex: INTEGER; 
my | nfo: TClassl nfo; 
my Si ze: INTEGER; 
my STP: TPSliceTabl e; 

BEGIN 


{$I FC fMaxTrace}BP( 1); {$ENDC} 
{$1 FC fMaxTrace}EP; {$ENDC} 
someDifference := FALSE; 
olderVersion := FALSE: 
newerVersion := FALSE; 
exWorld := TWorld(exClassWorld); {Separate statement because of a compiler bug} 
WTH exWorld DO 
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001292 BEGIN 

001293 numExCl asses := hExClasses**, header. size 

001294 

001295 IF numClasses <> numExClasses THEN 

001296 someDifference := TRUE; 

001297 

001298 FOR exindex := 1 TO numExClasses DO 

001299 BEGIN 

001300 myl ndex := IndexOfExClass(exWorld, exl ndex) 

001301 1F mylndex = 0 THEN 

001302 newer Version := TRUE 

001303 ELSE 

001304 BEGIN 

001305 exinfo := hExClasses**. records[ exl ndex] 

001306 exSize := exinfo. objectSize 

001307 exSTP := hExSTables**. records[exl ndex] 

001308 

001309 myl nfo := hMyClasses**. records[ myl ndex]; 

001310 mySize := myl nfo. obj ectSize 

001311 mySTP := hMySTables**. records[ my! ndex] 

001312 

001313 IF (mylnfo.version < exinfo.version) OR (mySize < exSize) THEN 
001314 newerVersion := TRUE; 

001315 

001316 IF (mylnfo.version > exInfo.version) OR (mySize > exSize) THEN 
001317 olderVersion := TRUE: 

001318 

001319 1F (mySTP <> exSTP) OR (myl nfo. oldestReadabl eVersion <> exInfo. oldestReadabl eVersion) THEN 
001320 someDifference := TRUE; 

001321 

001322 [F exinfo.superlndex = 0 THEN 

001323 BEGIN 

001324 1F mylnfo.superlndex <> 0 THEN 

001325 newerVersion := TRUE: 

001326 END 

001327 ELSE 

001328 1F mylnfo.superlndex <> IndexOfExClass(exWorld, exilnfo.superl ndex) THEN 
001329 newerVersion := TRUE; 

001330 END; 

001331 END; 

001332 END; 

001333 

001334 NeedConversion := someDifference OR olderVersion OR newer Versi on: 
001335 END; 

001336 

001337 


001338 {$8 SgCLAclI d} 
001339 PROCEDURE ConvertHeap(heap: THeap; exClassWorld: TClass World) 
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001340 

001341 {*** VERSION CONVERSION *** 

001342 Convert all the contents of heap fromits classes to ours. 

001343 The job is done in two passes through heap: 

001344 (1) ConvertClass changes the method-table pointer of each object, and may change its size 
001345 If the object grows, extra fields are defaulted to O/NIL. 

001346 (2) ConvertFields tells each object to "Convert(oldVersion)", thus giving the application a 
001347 chance to calculate extra fields or otherwise modify the converted object. } 
001348 

001349 VAR exWorld: TWorl d: 

001350 needPassTwo: BOOLEAN 

001351 numExCl asses: INTEGER 

001352 hExHashSTP: THI dxArray 

001353 hExEquivalent: THI dxArray 

001354 exindex: INTEGER; 

001355 

001356 {tolnsert, return: -1 if sliceTable already there or if table full, index if a hole found} 
001357 {not tolnsert, return: index (> 0) if sliceTable found, -1 if not there} 

001358 FUNCTION LookupSTP(stp: TPSliceTable; tolnsert: BOOLEAN): INTEGER; 

001359 

001360 FUNCTION CompareSTP(hashi ndex: INTEGER): THashCompare 

001361 VAR my! ndex: INTEGER; 

001362 BEGIN 

001363 myl ndex := hExHashS$TP**. records[hashli ndex] 

001364 1F mylndex = 0 THEN 

001365 CompareSTP := cHole 

001366 ELSE 

001367 IF exWorld. hExSTables**.records[ myl ndex] = stp THEN 

001368 CompareSTP := cMatch 

001369 ELSE 

001370 CompareSTP := cMismatch; 

001371 END; 

001372 

001373 BEGIN 

001374 LookupSTP := LookupI nHashArray( hExHashSTP**, header.size, ORD(stp), tolnsert, CompareSTP); 
001375 END; 

001376 

001377 FUNCTION Equivindex(exlndex: INTEGER): INTEGER 

001378 VAR tbl Index: INTEGER 

001379 myl ndex: INTEGER; 

001380 BEGIN 

001381 tbl index := exilndex; 

001382 

001383 WITH exWorld DO 

001384 WHILE tbl index <> 0 DO 

001385 WITH hExClasses**.records[tbl Index] DO 

001386 BEGIN 

001387 myl ndex := IndexOfExClass(exWorld, tbllndex) 
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001388 1F mylndex <> 0 THEN 

001389 IF version >= hMyClasses**. records[ myl ndex].oldestReadableVersion THEN 
001390 BEGIN 

001391 Equivindex := myl ndex; 

001392 EXI T( Equivindex); 

001393 END; 

001394 tbl Index := superl ndex; 

001395 END; 

001396 

001397 {$1 FC fDbgObj ect} 

001398 ABCBreak('No common superclass', exl ndex) 

001399 {$ENDC} 

001400 Equivindex := 0; 

001401 END; 

001402 

001403 FUNCTION FindClasses(object: TObject; VAR exIlndex, mylndex: INTEGER; VAR moreConversion: BOOLEAN) 
001404 : BOOLEAN; 

001405 {Given an object, return the original and my class index} 

001406 VAR stp: TPSliceTable 

001407 pStp: ATPSI|iceTable; (***) 

001408 exHashli ndex: INTEGER 

001409 exVersion: INTEGER 

001410 exSize: INTEGER; 

001411 BEGIN 

001412 FindClasses := FALSE; 

001413 {Determine the original class of the object fromits method table ptr} 

001414 stp := TPSliceTabl e( Hand! e( obj ect) **) 

001415 

001416 (***) 

001417 {Obtain access to its high byte} 

001418 pStp := @stp; 

001419 

001420 {stp probably has its exlndex stored in its high byte (unless > 255 or not a Clascal object)} 
001421 exIndex := TPByte( pStp) *; 

001422 TPByte(pStp)* := 0; {So the stp comparisons below will be uncluttered} 
001423 

001424 IF exindex < 0 THEN 

001425 exIndex := 256 + exindex; {Undo sign extension caused by TPByte*} 

001426 

001427 1F exindex <> 0 THEN {It might be a class pointer} 

001428 IF exlndex > numExClasses THEN 

001429 exindex := 0 {Not a real class pointer} 

001430 ELSE {Could not use "WTH exWorld" here because code generator balked} 
001431 1F exWorld. hExSTables**.records[exindex] <> stp THEN 

001432 exindex := 0: {Not a real class pointer} 

001433 (***){Also added next 3 comments bel ow} 

001434 

001435 1F exindex = 0 THEN {It is not a class pointer, or exl ndex>255} 
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IF numExClasses > 255 THEN {lt might be a class pointer after all} 
BEGIN {Look in the hash table} 
exHashi ndex := LookupSTP(stp, FALSE); 
IF exHashindex <= 0 THEN {Not a Clascal obj ect} 
Exit(FindClasses); 
exindex := hExHashSTP**, records[exHashl ndex]; 
END 
ELSE 
Exit(FindClasses); {not a Clascal object} 


{Determine the equivalent class in my process} 
mylndex := hExEquivalent**. records[exindex]; 
FindClasses := TRUE; 

WITH exWorld. hExClasses**,records[exl ndex] DO 


BEGIN 
exVersion := version; 
exSize := obj ectSize; 
END; 


WITH hMyClasses**. records[myl ndex] DO 
moreConversion := (exVersion < version) OR (exSize < objectSize); 


(**** Replaced the following line by the preceding because it is too complicated for the 
Spring Release code generator: 


WITH exWorld. hExClasses** DO 
moreConversion := (records[exlndex].version < hMyClasses**.records[ myl ndex].version) OR 
(records[exIl ndex].objectSize < hMyClasses**. records[ myl ndex]. obj ect Size); 
KK) 


END; 


PROCEDURE ConvertClass(object: TObject); 
{Pass 1: Map the method-table ptr fromthe original to mine and change the object size} 
VAR exI ndex: INTEGER; 
myl ndex: INTEGER; 
moreConverson: BOOLEAN; 
BEGIN 
{Determine both the original and my class} 
IF FindClasses(object, exlndex, mylndex, moreConversion) THEN 
BEGIN 
{Convert the method table pointer, change the size, default extra fields to 0/ NIL} 
ConvClass(object, exWorld, exindex, myl ndex); 
1F moreConversion THEN {a second pass will be needed to let the app do special defaulting} 
needPassTwo := TRUE; 
END; 
END; 


PROCEDURE ConvertFields(object: TObject); 
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001484 {Pass 2: Default extra fields; a separate pass so the application can follow pointers if need be} 
001485 VAR exI ndex: INTEGER 

001486 myl ndex: INTEGER 

001487 moreConverson: BOOLEAN 

001488 BEGIN 

001489 {Determine both the original and my class} 

001490 IF FindClasses(object, exlndex, mylndex, moreConversion) THEN 
001491 IF moreConversion THEN {Let the app supply extra fields etc. } 
001492 obj ect. Convert (exWorld. hExClasses**. records[exl ndex].versi on) 
001493 END; 

001494 

001495 BEGIN 

001496 {$1 FC fMaxTrace}BP(1); {$ENDC} 

001497 {$1 FC fMaxTrace}EP; {$ENDC} 

001498 exWorld := TWorl d(exClassWorl d) 

001499 WTH exWorld DO 

001500 BEGIN 

001501 numExClasses := hExClasses*%. header. size 

001502 

001503 {Make temporary arrays that will speed up reconciliation of the two worlds} 
001504 hExEquivalent := MakeldxArray(numExCl asses, FALSE); 

001505 FOR exIndex := 1 TO numExClasses DO 

001506 hExEquivalent**.records[exlndex] := Equivindex(exl ndex) 

001507 IF numExClasses > 255 THEN 

001508 BEGIN 

001509 hExHashSTP := MakeldxArray(numExClasses - 255, TRUE) 

001510 FOR exIndex := 256 TO numExClasses DO 

001511 hExHashSTP**. records[ LookupSTP( hExSTabl es**. records[exl ndex], TRUE)] := exlndex; 
001512 END; 

001513 END; 

001514 

001515 needPassTwo := FALSE; 

001516 {Pass One -- convert method table pointers (STPs)} 

001517 EachObject(heap, ConvertClass); 

001518 {Pass Two -- let application default extra fields} 

001519 IF needPassTwo THEN 

001520 EachObj ect( heap, ConvertFields) 

001521 

001522 {Free the temporary arrays} 

001523 FreeH( THz( mai nHeap), TH(hExEqui val ent) ) 

001524 IF numExClasses > 255 THEN (***) 

001525 FreeH( THz(mainHeap), TH( hExHashSTP)); 

001526 END; 

001527 

001528 


001529 {$$ sError} 
001530 PROCEDURE Clascal Reason(error: INTEGER; VAR s: $255); 
001531 BEGIN 
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CASE error OF 


OTHERWISE s := 'Some kind of problem ; {** Need more cases **} 
END; 

END; 

{$$ slnit1l} 

PROCEDURE ClascalError(error: INTEGER); {called with error = 0 after successful 

VAR s: $255; 

i: INTEGER; 

BEGIN 


IF error > 0 THEN 


BEGIN 
{$1 FC fDbgObj ect } 
Clascal Reason(error, s);} 
{$ENDC} 
IF isinitialized THEN 
BEGIN 
{$1 FC fDbgObj ect} 
ABCBreak(s, error); 
{$ENDC} 
Trmnt Excepti onHandl er 
END 
ELSE 
BEGIN 
{$1 FC fDbgObj ect} 
WriteLn('Clascal error: ', s); 
{$ENDC} 
IF wmisinitialized THEN 
InitErrorAbort(error) 
ELSE 
{$1 FC fDbgObj ect} 
% GoLisaBug 
{ELSEC} 
HALT; 
{$ENDC} 
END; 
END 


ELSE 
IF NOT classesInitialized THEN 


( ** RR 


BEGIN 


Clascal initialization} 


{*** STILL TO DO: The first time the programruns, write to the tool resource file ***} 


{Save conversion information not obtainable from UClascal in permanent arrays} 


hMyClasses := THClasses(TDynamicArray.CREATE(NIL, mainHeap, SI ZEOF(TClassinfo), numClasses) ) 
XferLeft(Ptr(pClasses), @hMyClasses**.records, numClasses * SI ZEOF(TClassinfo)); 
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hMySTables := THSTables(TDynamicArray. CREATE(NIL, mainHeap, SIZEOF(TPSliceTable), 
XferLeft(Ptr(pSTables), @hMySTables**.records, numClasses * SIZEOF(TPSIiceTable)); 


numCl asses) ); 


hMyAuthors := THAuthors(TDynamicArray.CREATE(NIL, mainHeap, SI ZEOF(TA32), numAuthors)); 


XferLeft(Ptr(pAuthors), @hMyAuthors**.records, numAuthors * SI ZEOF(TA32)); 


hMyAliases := THAliases(TDynamicArray.CREATE(NIL, mainHeap, SI ZEOF(TA8), numAliases)); 


XferLeft(Ptr(pAliases), @hMyAliases**.records, numAliases * SI ZEOF(TA8)); 


hMyClasses := THClasses(TArray.CREATE(NIL, mainHeap, numClasses, SIZEOF(TClassinfo))); 


TArray(hMyClasses).EditAt(1, numClasses); 
XferLeft(Ptr(pClasses), @hMyClasses**.records, numClasses * SI ZEOF(TClassinfo)); 


hMySTables := THSTables(TArray. CREATE(NIL, mainHeap, numClasses, SIZEOF(TPSIiceTable))); 


TArray(hMySTables). EditAt(1, numClasses); 
XferLeft(Ptr(pSTables), @hMySTables**.records, numClasses * SI ZEOF(TPSliceTable)); 


hMyAuthors := THAuthors(TArray. CREATE(NIL, mainHeap, numAuthors, SIZEOF(TA32))); 
TArray(hMyAuthors). EditAt(1, numAuthors); 
XferLeft(Ptr(pAuthors), @hMyAuthors**.records, numAuthors * SI ZEOF(TA32)); 


hMyAliases := THAliases(TArray.CREATE(NIL, mainHeap, numAliases, SI ZEOF(TA8))); 
TArray(hMyAliases). EditAt(1, numAliases); 
XferLeft(Ptr(pAliases), @hMyAliases**.records, numAliases * SI ZEOF(TA8)); 


WITH myWorld DO 


BEGIN 

infRecs := TArray(hMyClasses); {&&& field names are a bit confusing} 
classes := TArray(hMySTables); 

authors := TArray(hMyAuthors); 

aliases := TArray(hMyAliases); 

END; 


hMyHashName := MakeldxArray(numCl asses, TRUE); 
FOR i := 1 TO numClasses DO 


hMyHashName**, records[ LookupName(hMyClasses**.records[i].classAlpha, TRUE)] := 


END; 


METHODS OF TObj ect; 


Apple Lisa ToolKit 3.0 Source Code Listing -- 612 of 


1012 


001628 
001629 
001630 
001631 
001632 
001633 
001634 
001635 
001636 
001637 
001638 
001639 
001640 
001641 
001642 
001643 
001644 
001645 
001646 
001647 
001648 
001649 
001650 
001651 
001652 
001653 
001654 
001655 
001656 
001657 
001658 
001659 
001660 
001661 
001662 
001663 
001664 
001665 
001666 
001667 
001668 
001669 
001670 
001671 
001672 
001673 
001674 
001675 


Apple Lisa Computer Technical 


Information 


{$$ sStartup} 


PROCEDURE TObj ect. Become(object: TObject); 


LABEL 1; 


VAR hSelf: TH; 
hObj: TH; 
bkSelf: TBk; 
bkObj: TBk; 


p: 
{$1FC LibraryVersion <= 20} 
oh: TC; 
{$ELSEC} 
tempBP: TBp 
{$ENDC} 
BEGIN 


{$I FC fTrace}BP( 4); {$ENDC} 
|F SELF.Heap <> object. Heap THEN 


BEGIN 
{$1 FC fDbgObj ect} 
WriteLn( ORD( SELF) ); 


ABCBreak('Attempt to Become an object on another heap', ORD(object)); 


{$ENDC} 
GOTO 1; 
END; 


hSelf := TH(SELF); 
hObj := TH( object); 


bkSelf := TBk(ORD(hSelf*) - 
bkObj := TBk(ORD(hObj*) - 


p := hSelf*; 
hSelf* := hObj * 
hObj * := p; 


{$1FC LibraryVersion <= 20} 
oh := bkSelf%. oh; 
bkSelf*.oh := bkObj *. oh; 
bkObj *.oh := oh; 
{$ELSEC} 
tempBP := bkSelf™%*. bp; 
bkSelf*. bp := bkObj *. bp 
bkObj *. bp : = tempBP 
{$ENDC} 


object. Free; 
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1: 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ sStartup} 
FUNCTION TObject. Class: TClass 
BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
Class := ClassPtr(Handl e(SELF)); 
{$IFC fMaxTrace}EP; {$ENDC} 
END; 


{$5 sRes} 


FUNCTION TObject.Clone(heap: THeap): TObject; 


BEGIN 
{$1 FC fMaxTrace}BP(1); {$ENDC} 
Clone := SELF.Cl oneObj ect(heap); 
{$1FC fMaxTrace}EP; {$ENDC} 

END; 


{$$ sRes} 


FUNCTION TObject.CloneObject(heap: THeap): TObject; 


VAR hz: THz: 
size: INTEGER; 
source: TH; 
dest: TH: 
BEGIN 
{$IFC fTrace}BP( 2); {$ENDC} 
hz := THz(heap); 
source := TH(SELF); 
size := chDataOfH(hz, source) 
dest := HAllocate(hz, size); 
XferLeft(@source**, @dest**, size); 
CloneObject := TObject(dest); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sStartup} 
PROCEDURE TObj ect. Free 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
SELF. FreeQbj ect; 
{$SIFC fTrace}EP; {$ENDC} 
END; 
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sStartup} 
PROCEDURE TObj ect. FreeObj ect; 
VAR heap: THeap; 


numObj ects: INTEGER 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
heap := SELF. Heap; 
FreeH(THz( heap), TH(SELF)); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


sStartup} 
FUNCTION TObject.Heap: THeap; 
BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
Heap := THeap(HzFromH( TH( SELF) )); 
END; 


sRes} 

FUNCTION TObject.HeapBytes: INTEGER; 

BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
HeapBytes := CbhDataOfH(HzFromH( TH(SELF)), TH(SELF)); 
{$IFC fTrace}EP; {$ENDC} 

END; 


sLOX} 
PROCEDURE TObj ect. Read(s: TStringScanner) 
BEGIN 
{$IFC fTrace}BP( 2); {$ENDC} 
s.XferFields(xRead, SELF); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


sLOX} 
PROCEDURE TObject.Write(s: TStringScanner); 
BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
s.XferFields(xWrite, SELF); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$1 FC fDebugMet hods} 


{$$ 


SgCLAdbg} 
PROCEDURE TObject.Debug(numLevels: INTEGER; memberTypeStr: $255) 
VAR class: TClass 
name: TCl ass Name; 
str: $255; 
{$1 FC fTrace} 
ol dFlag: BOOLEAN; 
{$ENDC} 


BEGI 


END; 
{$5 


PROCEDURE Suppl yObj Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 

SELF. Fields(Field); 

END; 


N 

{$lFC fTrace} 

oldFlag := fDebugRecursi on; 
f DebugRecursion := TRUE; 
{$ENDC} 


class := SELF.Class 
CpToCn(TPSliceTable(class), TS8(name)); 
Tri mBl anks( @name) ; 

WreStr(Concat(name, ' ')); 


{$1 FC fDebugMet hods} 
IF numLevels > 0 THEN 
WriteDRecord(numLevels, Handle(SELF), 4, Suppl yObj Fields); {4 skips method table ptr} 
{$ELSEC} 
Li nt ToHex(ORD(SELF), @str); 
str := Concat('-- $', str); 
IF NOT Vali dObj ect(Handle(SELF)) THEN 
str := Concat('Invalid Object', str); 
Wr Str(str); 
{$ENDC} 


{$IFC fTrace} 
f DebugRecursion := oldFlag 
{$ENDC} 


SgCLAres} 


{$ENDC} 


{$1 FC fDebugMet hods } 
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001820 {$S SgCLAdbg} 

001821 PROCEDURE TObj ect. Fields( PROCEDURE Field(nameAndType: $255)) 
001822 BEGIN 

001823 END; 

001824 {$S SgCLAres} 

001825 {$ENDC} 

001826 

001827 

001828 {$S SgCLAcl d} 

001829 PROCEDURE TObj ect. Convert(fromVersion: Byte); 

001830 BEGIN 

001831 {$I FC fMaxTrace}BP(1); {$ENDC} 

001832 {$I1FC fMaxTrace}EP; {$ENDC} 

001833 END; 

001834 {$S SgCLAres} 

001835 

001836 

001837 {$8 SgCLAcl d} 

001838 FUNCTION TObject.JoinClass(newClass: TClass): TObject; 
001839 VAR oldClass: TClass 

001840 BEGIN 

001841 {$I1FC fTrace}BP(7); {$ENDC} 

001842 oldClass := SELF. Class 

001843 IF NOT ClassDescendsFrom(oldClass, newClass) THEN 
001844 IF ClassDescendsFrom(newClass, oldClass) THEN 
001845 Recreate(SELF, SizeOfCp(TPSliceTabl e( oldClass)), 
001846 SizeOfCP(TPSliceTable(newClass)), TPSliceTable(newClass)) (***) 
001847 ELSE 

001848 {$1 FC fDbgObj ect} 

001849 ABCBreak('An Object cannot move to an unrelated class', ORD(newClass)) 
001850 {$ENDC}; 

001851 JoinClass := SELF; 

001852 {$I1FC fTrace}EP; {$ENDC} 

001853 END; 

001854 {$S SgCLAres} 

001855 

001856 


001857 {$$ slnit1} 

001858 BEGIN {Class Initialization} 

001859 

001860 InitClascal(ClascalError); {Provide an error routine in case of errors in Clascal run-time support} 
001861 Init Object; {Do remaining initialization} 
001862 

001863 Unit Author('Apple') 

001864 

001865 cObject := THISCLASS; 

001866 

001867 END; 
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001868 
001869 
001870 
001871 


End of File -- Lines: 1871 Characters: 57741 
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{INCLUDE FILE UOB)ECT3 -- COLLECTIONS} 
{Copyright 1983, 1984, Apple Computer, Inc. } 


{Segments: SgCLAini(tialize and Terminate), SgCLAres(ident), SgCLAc(o)Id, SgCLAdbg} 


{$S sResDat} 

PROCEDURE XferContiguous(whichWay: xReadWrite; collection: TCollection; alsoSkip: INTEGER; s: TStringScanner) 
{Transfer the size (as an INTEGER), class-specific fields (after alsoSkip bytes), and all members. 
Do not recur on the members. 
Do not transfer the class, the dynStart (=SizeOfClass), or the hole info (=zero) 
When reading, append the elements that are read 
This only works for contiguous objects up to 32K members in size. } 

VAR size: INTEGER 

numloXfer: INTEGER 


BEGIN 
{$1 FC fTrace}BP(3); {$ENDC} 
size := collection.size 


collection. StopEdit; 
CASE whichWay OF 


xRead: 
BEGIN 
numToXfer := s. ReadNumber(2); 
collection. EditAt(size + 1, numToXfer) 
size := collection.size 
END; 

xWrite: 
BEGIN 
numToXfer := size 
s. WriteNumber(numToXfer, 2); 
END; 

END; 


s. XferSequenti al (whichWay, 
Ptr( ORD( Handle(collection)*) + SIZEOF(TCollection) + alsoSkip), 
size * collection. Member Bytes) 
{$1 FC fTrace}EP; {$ENDC} 
END; 


{INVARIANT ON TCollections: 
given a collection c, 
the elements of the collection are stored at physical indices: 
[1..c.holeStart] and [c. holeStarttc. hol eSizetl..c.Sizetc. hol eSi ze] 
the hole occupies physical indices: 
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[c. holeStarttl..c.holeStart+c. hol eSi ze] 


OF TCollection; 


{$8 sResDat} 
FUNCTION TCollection. CREATE(object: TObject; heap: THeap; initialSlack: INTEGER): TColl ection; 


BEGI 


N 
{$IFC fTrace}BP(1); {$ENDC} 
IF object = NIL THEN 
ABCBreak('TCollection. CREATE must be passed an already-allocated object by a subclass CREATE', 0); 
SELF := TCollection(obj ect); 
WITH SELF DO 
BEGIN 
size := 0; 


{$H-} dynStart := SizeOfClass(SELF.Class); {$H+} 


END; 


holeStart := 0; 
holeSize := initial Slack 
holeStd := 0; 


END; 
{$I1FC fTrace}EP; {$ENDC} 


{$S sResDat} 
FUNCTION TCollection. Clone( heap: THeap): TObj ect; 


BEGI 


END; 


VAR numMembers: INTEGER 
collection: TColl ection; 


N 
{$I FC fTrace}BP( 4); {$ENDC} 
numMembers := SELF. size; 


collection := TCollection(NewDynObj ect( heap, SELF.Class, numMembers * SELF. Member Bytes) ); 
XferLeft(Ptr(Handle(SELF)*), Ptr(Handle(collection)*), SELF. dynStart); 

collection := TCollection, CREATE(collection, heap, numMembers) 

collection. | nsManyAt(1, SELF, 1, numMembers); 

Clone := collection; 

{$1FC fTrace}EP; {$ENDC} 


{$1 FC fDebugMet hods} 


{$$ 


SgCLAdbg} 


PROCEDURE TCollection. Fields( PROCEDURE Field(nameAndType: $255) ) 


BEGI 


N 

SUPERSELF. Fields( Field); 
Field('size: LONGI NT' ) 
Field('dynStart: INTEGER'); 
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Field('holeStart: I NTEGER'); 
Field('holeSize: | NTEGER'); 
Field('holeStd: I NTEGER' ) 

END; 

{$S SgCLAres} 

{$ENDC} 


{$1 FC fCheckl ndices} 

{$8 SgCLAdbg} 

PROCEDURE TColl ection. Check! ndex(index: LONGI NT); 

BEGIN 

{$I FC fMaxTrace}BP(1); {$ENDC} 

{$IFC fMaxTrace}EP; {$ENDC} 

IF (index < 1) OR (index > SELF.size) THEN 
ABCBreak('Checkil ndex', index); 

END; 

{$S SgCLAres} 

{$ENDC} 


{$$ sResDat} 


FUNCTION TCollection. AddrMember(i: LONGINT): LONGI NT 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
{$1 FC fDbgObj ect} 
IF SELF.dynStart = MAXINT THEN 
ABCBreak('No dynamic part', i); 
{$ENDC} 
{$IFC fCheckl ndices} 
IF fCheckIl ndices THEN 
IF (i < 1) OR (i > SELF.size+1l) THEN 
ABCBreak('Checkl ndex', i); 
{$ENDC} 


[F i > SELF. holeStart THEN 
i := i + SELF. holeSize 
{i is now a physical index} 


AddrMember := TpLONGINT(SELF)* + SELF. dynStart + (SELF.MemberBytes * (i - 1)); 


{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ sRes Dat} 


PROCEDURE TCollection. CopyMembers(dstAddr, startIindex, howMany 
VAR member Bytes: INTEGER; 
bef oreHol e: INTEGER 
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srcAddr: LONGI NT; 
j: | NTEGER; 
offset: INTEGER 
numBytes: INTEGER 


BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
IF startIlndex < 1 THEN 
startIindex := 1; 
howMany := Min(howMany, SELF.size + 1 - startIndex) 


IF (howMany > 0) AND (startindex <= SELF.size) THEN 
BEGIN 
memberBytes := SELF. Member Bytes 


beforeHole := Min(howMany, SELF. holeStart + 1 - startIndex) 
srcAddr := SELF. AddrMember(startl ndex); 


1F beforeHole > 0 THEN 
BEGIN 
numBytes := beforeHole * member Bytes; 


XferLeft(Ptr(srcAddr), Ptr(dstAddr), numBytes); 
dstAddr := dstAddr + numBytes 
END 
ELSE 
beforeHole := 0 


1F beforeHole < howMany THEN 
BEGIN 
srcAddr := SELF.AddrMember(startI ndex + beforeHole); 
XferLeft(Ptr(srcAddr), Ptr(dstAddr), (howMany - beforeHole) * member Bytes); 
END; 


END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$S sResDat} 
{AFTER EXECUTING THIS METHOD: 
1F deltaMembers >= 0, 
physical positions [atIndex..atIndextdeltaMembers-1] are available for adding new members. 


IF deltaMembers < 0, 
actual members [atl ndex..atIl ndex-deltaMemberst+1] have been removed 


NOTE: This routine does not preserve the TCollection invariant. 


PROCEDURE TCollection. EditAt( ati ndex: LONGINT;: deltaMembers: I NTEGER) 
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VAR ol dHoSi ze: INTEGER 
newHoSi ze: INTEGER 
ol dHoStart: INTEGER 
newHoStart: INTEGER; 
maxHoStart: INTEGER; 
mi nHoStart: INTEGER 
size: INTEGER; 
b: 0..1; 
BEGIN {Removes any hole it creates unless holdStd <> 0} 
{$I1FC fTrace}BP( 4); {$ENDC} 
{$1 FC fDbgObj ect } 
IF SELF.dynStart = MAXINT THEN 
ABCBreak('No dynamic part', atl ndex); 
{$ENDC} 


{Force atl ndex and deltaMembers into the valid range} 
ati index := Max(1, Min(atindex, SELF.size + 1)) 


1F deltaMembers < 0 THEN 
deltaMembers := Min(0, Max(deltaMembers, atl ndex - SELF.size - 1)) 


(***** Range checks not necessary with the above code 
{$IFC fCheckl ndices} 
IF fCheckl ndices THEN 
BEGIN 
IF atindex <> (SELF.size + 1) THEN 
SELF. Checkl ndex( ati ndex); 
IF deltaMembers < 0 THEN 
SELF. CheckIl ndex(atIindex - 1 - deltaMembers); 
END; 
{$ENDC} 


KKK) 


ol dHoSize := SELF. holeSize 
oldHoStart := SELF. holeStart; 


IF (deltaMembers < 0) AND ((oldHoStart + 1) = atIndex) THEN {the hole is right before the deletion} 
SELF. holeStart := oldHoStart - deltaMembers {deltaMembers is going to be added in again | ater} 


ELSE 
BEGIN 
newHoStart := atindex - 1 - Min(deltaMembers, 0); 
IF (deltaMembers > ol dHoSize) OR (newHoStart <> oldHoStart) THEN 
BEGIN 
maxHoStart := Max(oldHoStart, newHoStart); 
newHoSize := Max(oldHoSize, deltaMembers); 


1F newHoSize > ol dHoSize THEN 
BEGIN 
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000236 {increase the space allocated to the collection, and shift the collection so that the 
000237 the last real element is at the end of the space allocated to the collection; 
000238 but only move REAL elements that will end up after the hole} 

000239 

000240 size := SELF.size 

000241 newHoSize := Max(newHoSize, SELF. hol eStd) 

000242 SELF. ResizeColl(size + newHoSi ze); 

000243 SELF. ShiftColl(maxHoStart + oldHoSize, maxHoStart + newHoSize, size - maxHoStart); 
000244 

000245 {Explanation of the above line: 

000246 maxHoStart = max # real elements before the hole (in initial and final collections) 
000247 size = # real elements in the initial collection 

000248 therefore, size - maxHoStart is min # real elements after the hole, which 
000249 is the right number of elements to move 

000250 

000251 the allocated size of the collection is size + newHoSize (from SELF. Resi zeCol |) 
000252 to get the last real element we are moving to be at the end of the allocated space, 
000253 we need to move the first element to 

000254 allocated size of collection - # elements moving 

000255 = size + newHoSize - (size - maxHoStart) 

000256 =  maxHoStart + newHoSi ze 

000257 

000258 we increased the size of the collection by newHoSize - oldHoSize 

000259 therefore the first source element must be 

000260 first destination element - (newHoSize - ol dHoSi ze) 

000261 = maxHoStart + newHoSize - (newHoSize - ol dHoSi ze) 

000262 =  maxHoStart + ol dHoSize 

000263 } 

000264 END; 

000265 

000266 I1F newHoStart <> oldHoStart THEN 

000267 BEGIN 

000268 b := ORD(newHoStart > ol dHoStart); {1 if hole is moving right and data is moving left, 
000269 0 otherwise} 

000270 mi nHoStart := Min(oldHoStart, newHoStart); 

000271 SELF. ShiftColl(minHoStart + oldHoSize*b, minHoStart + newHoSize*(1-b) 

000272 maxHoStart - minHoStart); 

000273 END; 

000274 

000275 SELF. holeStart := newHoStart; 

000276 SELF. holeSize := newHoSize 

000277 END; 

000278 END; 

000279 

000280 WITH SELF DO 

000281 BEGIN 

000282 size := size + deltaMembers 

000283 holeSize := holeSize - deltaMembers 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
000295 
000296 
000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 


{$8 


{$8 
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holeStart := holeStart + deltaMembers 
IF oldHoSize = 0 THEN 
IF holeStd = 0 THEN 
IF holeSize > 0 THEN 
{$H- } SELF.StopEdit; {$H+} 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
FUNCTION TCollection. Equals(otherCollection: TCollection): BOOLEAN 
LABEL 1; 
VAR memberBytes: | NTEGER 
size: INTEGER; 
i: INTEGER; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
Equals := FALSE; 
memberBytes := SELF. Member Bytes; 
size := SELF.size; 
IF SELF = otherCollection THEN 
Equals := TRUE 
ELSE 
IF size = otherCollection.size THEN 
|F memberBytes = otherCollection. Member Bytes THEN 
BEGIN 
FOR i := 1 TO size DO 
IF NOT Equal Bytes(Ptr(SELF.AddrMember(i)), Ptr(otherCollection. AddrMember(i)), 
memberBytes) THEN 
GOTO 1; 
Equals := TRUE; 
END; 


1: 
{$I1FC fTrace}EP; {$ENDC} 
END; 


sRes Dat } 
PROCEDURE TCollection. I nsManyAt(i: LONGINT; otherCollection: TCollection; index, howMany: LONGI NT); 
BEGI N {Stops edit if it wasn't explicitly started} 

{$IFC fTrace}BP( 3); {$ENDC} 

{$1 FC fDbgObj ect } 

IF SELF.dynStart = MAXINT THEN 

ABCBreak('No dynamic part', i); 
{$ENDC} 


{$1 FC fCheckl ndices} 
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000332 
000333 
000334 
000335 
000336 
000337 
000338 
000339 
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000345 
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000352 
000353 
000354 
000355 
000356 
000357 
000358 
000359 
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000362 
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000365 
000366 
000367 
000368 
000369 
000370 
000371 
000372 
000373 
000374 
000375 
000376 
000377 
000378 
000379 
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| Information 


IF fChecki ndices AND (howMany > 0) THEN 


BEGIN {i is checked by EditAt} 

|F SELF. memberBytes <> otherCollection. MemberBytes THEN 
BEGIN 
WriteLn; 


WriteLn('*** ERROR: Tried to insert ', otherCollection. Member Bytes: 1, 
'-byte Members into a TCollection with ', SELF. memberBytes, '-byte Members'); 


ABCbreak('InsManyAt', howMany); 
END; 


(***** Dont need range checks anymore 


KKK) 


END; 


otherColl ection. Checkl ndex( index): 
otherCollection. CheckIl ndex(index + howMany - 1) 


END; 


{$ENDC} 


1F howMany > 0 THEN 


BEGIN 
SELF. Edit At(i, howMany) 


otherCollection. CopyMembers(SELF.AddrMember(i), index, 
END; 


{$lFC fTrace}EP; {$ENDC} 


{$$ SgABCdat } 
PROCEDURE TCollection.InsNullsAt(i, howMany: LONGI NT); 


END; 


VAR dst Addr: LONGI NT; 
BEGIN 


FC fTrace}BP(4); {$ENDC} 

FC f DbgObj ect } 

SELF.dynStart = MAXINT THEN 
ABCBreak('No dynamic part', i); 


{$ENDC} 


SELF. EditAt(i, howMany); 
1F howMany > 0 THEN 


BEGIN 
dstAddr := SELF.AddrMember(i); 
TPByte(dstAddr)* := 0 


howMany); 


XferLeft(Ptr(dstAddr), Ptr(dstAddr + 1), howMany * SELF. Member Bytes- 1); 
{WARNING: The success of the preceding line depends on the fact the XferLleft 
copies data 1 byte at a time; use of a routine that tries to optimize the 
transfer will negatively impact the correctness of this method. } 


END; 
{$I1FC fTrace}EP; {$ENDC} 
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{$$ sResDat} 
{NOTE: This routine does not preserve the TCollection invariant. } 


PROCEDURE TColl ection. ResizeColl(membersPlusHole: INTEGER); 


BEGI 


END; 


N 
{$IFC fTrace}BP( 4); {$ENDC} 
{$1 FC fDbgObj ect} 
IF SELF.dynStart = MAXINT THEN 
ABCBreak('No dynamic part', membersPlusHole); 
{$ENDC} 


1F membersPlusHole <> (SELF.size + SELF. holeSize) THEN 
ResizeDynObject(SELF, SELF.dynStart + (membersPlusHole * SELF. Member Bytes) ); 
{$IFC fTrace}EP; {$ENDC} 


{$S sResDat} 
{NOTE: This routine does not preserve the TCollection invariant. } 


PROCEDURE TCollection. ShiftColl(afterSrclndex, afterDstIl ndex, howMany: I NTEGER) 


BEGI 


VAR member Bytes: INTEGER; 
numBytes: INTEGER 
startAddr: LONGI NT; 
srcAddr: LONGI NT; 
dstAddr: LONGI NT; 
N 
{$I FC fTrace}BP( 4); {$ENDC} 
{$1 FC fDbgObj ect} 
IF SELF.dynStart = MAXINT THEN 
ABCBreak('No dynamic part', howMany); 
{$ENDC} 
IF (howMany > 0) AND (afterSrclndex <> afterDstIndex) THEN 
BEGIN 
memberBytes := SELF. Member Bytes 
numBytes := howMany * memberBytes 


startAddr := TpLONGINT(SELF)* + SELF. dynStart 
srcAddr := startAddr + afterSrclndex * memberBytes 
dstAddr := startAddr + afterDstI ndex * memberBytes 
IF afterSrclndex < afterDstIndex THEN 
XferRight(Ptr(srcAddr), Ptr(dstAddr), numBytes) 
ELSE 
XferLeft(Ptr(srcAddr), Ptr(dstAddr), numBytes); 
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000428 END; 

000429 {$I1FC fTrace}EP; {$ENDC} 

000430 END; 

000431 

000432 

000433 {$8 SgABCdat } 

000434 PROCEDURE TCollection. StartEdit(withSlack: INTEGER); 
000435 BEGIN 

000436 {$I1FC fTrace}BP( 4); {$ENDC} 

000437 {$I1FC fDbgObj ect} 

000438 IF SELF.dynStart = MAXINT THEN 
000439 ABCBreak('No dynamic part', withSlack); 
000440 {$ENDC} 

000441 

000442 SELF. holeStd := withSlack 

000443 {$I1FC fTrace}EP; {$ENDC} 

000444 END; 

000445 

000446 

000447 {$$ sResDat} 

000448 PROCEDURE TCollection. StopEdit; 

000449 BEGIN 

000450 {$1FC fTrace}BP( 4); {$ENDC} 

000451 {$1 FC fDbgObj ect} 

000452 IF SELF.dynStart = MAXINT THEN 
000453 ABCBreak('No dynamic part', 0); 
000454 {$ENDC} 

000455 

000456 IF SELF. holeStart < SELF.size THEN 
000457 SELF. EditAt(SELF.size + 1, 0) 
000458 SELF. ResizeColl (SELF. size); 

000459 SELF. holeStd := 0 

000460 SELF. holeSize := 0: 

000461 {$I1FC fTrace}EP; {$ENDC} 

000462 END; 

000463 

000464 


000465 {$$ slnit1} 

000466 BEGIN 

000467 

000468 {$1 FC fCheckli ndices} 
000469 fCheckl ndices := FALSE: 
000470 {$ENDC} 

000471 

000472 END; 

000473 {$8 SgCLAres} 

000474 

000475 
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000476 METHODS OF TList 


000477 

000478 

000479 {$$ sResDat} 

000480 FUNCTION TList.CREATE(object: TObject; heap: THeap; initialSlack: INTEGER): TList; 
000481 BEGIN 

000482 {$I1FC fTrace}BP(1); {$ENDC} 

000483 IF object = NIL THEN 

000484 object := NewDynObject( heap, THISCLASS, initialSlack * SI ZEOF(Handle)) 
000485 SELF := TList(TCollection. CREATE( object, heap, initial Slack)); 
000486 {$I1FC fTrace}EP; {$ENDC} 

000487 END; 

000488 

000489 

000490 {$$ sResDat} 

000491 PROCEDURE TList. Free 

000492 BEGIN 

000493 {$I1FC fTrace}BP( 4); {$ENDC} 

000494 SELF. Each( Free); 

000495 SUPERSELF. Free 

000496 {$IFC fTrace}EP; {$ENDC} 

000497 END; 

000498 

000499 

000500 {$8 SgABCdat } 

000501 FUNCTION TList.Clone(heap: THeap): TObj ect; 
000502 VAR |: TList; 

000503 j: INTEGER; 

000504 x: TObj ect; 

000505 BEGIN 

000506 {$I1FC fTrace}BP( 4); {$ENDC} 

000507 |] := TList(SUPERSELF. Cl one( heap) ) 

000508 FOR j := 1 T01.size DO 

000509 BEGIN 

000510 x := SELF. At(j); 

000511 1F x <> NIL THEN 

000512 1, PutAt(j, x.Clone(heap), FALSE) 
000513 END; 

000514 Clone := 1: 

000515 {$I1FC fTrace}EP; {$ENDC} 

000516 END; 

000517 

000518 

000519 {$1 FC fDebugMet hods} 

000520 {$8 SgCLAdbg} 

000521 PROCEDURE TList.Debug(numLevels: INTEGER; memberTypeStr: $255) 
000522 VAR s: TListScanner 

000523 obj: TObj ect; 
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str: $8; 
first: BOOLEAN 
{$lFC fTrace} 
ol dFlag: BOOLEAN 
{$ENDC} 

BEGIN 


{$IFC fTrace} 
oldFlag := fDebugRecursi on; 
f DebugRecursion := TRUE; 


{$ENDC} 
SUPERSELF. Debug(numLevels, ''); { this prints other fields of the list } 
IF numLevels > 0 THEN 
BEGIN 
WrStr('('); 
1F numLevels = 1 THEN { compressed list of classes } 
SELF. DebugMembers 
ELSE { list of classes and their handles } 
BEGIN 
s := SELF. Scanner 
IF s. position = SELF. holeStart THEN 
Write(' <=HOLE=>' ) 
first := TRUE: 
WHILE s.Scan(obj) DO 
BEGIN 
1F NOT first THEN 
WStr(', '): 
first := FALSE; 
IF obj = NIL THEN 
Wr Str(' NIL') 
ELSE IF ValidObject(Handle(obj)) THEN 
obj .Debug(numLevels-2, '') 
ELSE 
WrStr('<Invalid Object>'); 
IF numLevels = 2 THEN 
BEGIN 
LI ntToHex(ORD4(obj), @str); 
WrStr(CONCAT(': $', str)); 
END; 
IF s.position = SELF. holeStart THEN 
Write(' <=HOLE=>') 
END; 
END; 
WrStr(')'); 
END; 


{$I1FC fTrace} 
f DebugRecursion := oldFlag 
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{$ENDC} 


END; 


{$S SgCLAres} 


{$8 SgCLAdbg} 
PROCEDURE TList. DebugMembers 


VAR y: TObj ect; 
S! TListScanner; 
str: $8; 
initial: BOOLEAN 
class: TClass; 
thisClass: TCl assName 
prevClass: TCl assName 
sameCl ass: INTEGER 
charCount: INTEGER 
PROCEDURE WriteMembers 
VAR charsNeeded: INTEGER; 
BEGIN 


END; 


IF sameClass = 0 THEN EXIT(WriteMembers); 
1F sameClass = 1 THEN 
charsNeeded := 10 
ELSE 
charsNeeded := 13: 
IF initial THEN 
initial := FALSE 
ELSE IF (charCount + charsNeeded) > 70 THEN 
BEGIN 
WStr(','); 
Wren; 
Wr Str(' '); 
charCount := 10; 
END 
ELSE 
WStr(', '): 


str := prevClass; 
WrStr(str); 


1F sameClass > 1 THEN 
BEGIN 
IntToStr(sameClass, @str); 
Wr Str(CONCAT('*', str)); 
END; 


charCount := charCount + charsNeeded 
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BEGIN 


IF SELF.size > 0 THEN {prevent initialization anomaly in BP(i)/ EP} 


BEGIN 
charCount := 
initial :=T - 
sameClass := 
prevClass := ' 
s := SELF. Scanner 
WHILE s.Scan(y) DO 

BEGIN 

IF y = NIL THEN 

thisClass := 'NIL' 


c 
RU 
0 


Min(indentTrace, 20) + 30 
E 


ELSE IF ValidObj ect(Handle(y)) THEN 


BEGIN 
class := y.Class 


CpToCn(TPSliceTable(class), TS8(thisClass)); 


END 
ELSE 
thisClass := '22222222'; 


IF thisClass <> prevClass THEN 


BEGIN 
WriteMembers; 
sameClass := 1; 
END 
ELSE 
sameClass := sameClass + 1: 


prevClass := thisClass 
D; 
Wri teMembers 
END; 
END; 
{$$ SgCLAres} 
{$ENDC} 


{$5 sResDat} 
FUNCTION TList.At(i: LONGINT): TObject; 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
{$1 FC fCheckl ndices} 
1F fCheckl ndices THEN 
SELF. Checkl ndex(i); 
{$ENDC} 


{At := TPObj ect(SELF.AddrMember(i)) *; 


but for speed... } 
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000668 
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000674 
000675 
000676 
000677 
000678 
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000684 
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000703 
000704 
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000706 
000707 
000708 
000709 
000710 
000711 
000712 
000713 
000714 
000715 


{$5 


{$8 


{$8 
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IF i > SELF. holeStart THEN 
i :=i + SELF. holeSize 
At := TPObj ect(TpLONGINT(SELF)* + SELF.dynStart + (4 * (i - 1)))%; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TList. Del All (freeOld: BOOLEAN) 
BEGIN 

{$1FC fTrace}BP( 4); {$ENDC} 

IF freeOld THEN 

SELF. Each( Free); 

SELF. EditAt(1, -SELF.size); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TList. Del At(i: LONGINT; freeOld: BOOLEAN); 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
{$IFC fCheckl ndices} 
IF fCheckl ndices THEN 
SELF. Checkl ndex(i); 
{$ENDC} 


IF freeOld THEN 
Free( SELF. At(i)); 
SELF. EditAt(i, -1); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TList. Del First(freeOld: BOOLEAN); 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
SELF. Del At(1, freeOld); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TList.DelLast(freeOld: BOOLEAN) 
BEGIN 

{$1FC fTrace}BP( 3); {$ENDC} 
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000716 SELF. Del At(SELF.size, freeOld) 
000717 {$I1FC fTrace}EP; {$ENDC} 

000718 END; 

000719 

000720 

000721 {$8 SgABCdat } 

000722 PROCEDURE TList. Del ManyAt(i, howMany: LONGINT; freeOld: BOOLEAN) 
000723 VAR j: INTEGER; 

000724 BEGIN 

000725 {$IFC fTrace}BP( 4); {$ENDC} 

000726 1F howMany > 0 THEN 

000727 BEGIN 

000728 {$1 FC fCheckl ndices} 

000729 IF fChecklndices THEN 

000730 BEGIN 

000731 SELF. ChecklI ndex(i); 

000732 SELF. Check! ndex( i thowMany- 1) 
000733 END; 

000734 {$ENDC} 

000735 IF freeOld THEN 

000736 FOR j := 0 TO howMany - 1 DO 
000737 Free(SELF.At(i + j)); 
000738 SELF. EditAt(i, -howMany) 

000739 END; 

000740 {$1FC fTrace}EP; {$ENDC} 

000741 END; 

000742 

000743 

000744 {$8 SgABCdat } 

000745 PROCEDURE TList. Del Object(object: TObject; freeOld: BOOLEAN) 
000746 VAR y: TObj ect; 

000747 s: TListScanner: 

000748 BEGIN {If there is more than one occurrence, and editing is off, this calls StopEdit more than once} 
000749 {$I1FC fTrace}BP( 4); {$ENDC} 

000750 s := SELF. Scanner 

000751 WHILE s.Scan(y) DO 

000752 IF y = object THEN 

000753 s. Del ete( FALSE); 

000754 IF freeOld THEN 

000755 Free(obj ect); 

000756 {$I1FC fTrace}EP; {$ENDC} 

000757 END; 

000758 

000759 

000760 {$$ sResDat} 

000761 PROCEDURE TList.Each( PROCEDURE DoToObj ect(object: TObject)); 
000762 VAR holeStart: INTEGER: 

000763 offset: INTEGER; 
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000774 
000775 
000776 
000777 
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000790 
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000798 
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000802 
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000804 
000805 
000806 
000807 
000808 
000809 
000810 
000811 


{$$ 


{$8 


{$8 
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j: | NTEGER: 
pObject: TPObj ect; 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
holeStart := SELF. hol eStart; 
offset := SELF. dynStart; 
FOR j := 0 TO SELF.size - 1 DO 
BEGIN 
IF j = holeStart THEN 
offset := offset + 4 * SELF. holeSize 
pObject := TPObject( TpLONGI NT(SELF)* + offset); 
DoToObj ect( pObj ect *); 
offset := offset + 4; 
END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


sRes Dat } 
FUNCTION TList. First: TObj ect 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
First := SELF.At(1); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


sRes Dat} 

PROCEDURE TList.InsAt(i: LONGINT; object: TObject); 
VAR pObject: TPObj ect; 

BEGIN 
{$IFC fTrace}BP( 4); {$ENDC} 
SELF. EditAt(i, 1); 
pObject := TPObj ect(SELF. AddrMember(i)); 
pObject* := object 


{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TList.InsFirst(object: TObject); 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
SELF. I nsAt(1, object); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$8 


{$8 


{$8 


{$8 


{$8 


Apple Lisa Computer Technical Information 


sRes Dat } 
PROCEDURE TList.InsLast(object: TObject); 
BEGIN 
{$1 FC fTrace}BP( 3); {$ENDC} 
SELF.I nsAt(SELF.size + 1, object); 
{$1FC fTrace}EP; {$ENDC} 


END; 

sRes Dat } 

FUNCTION TList. Last: TObject; 

BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
Last := SELF. At(SELF. size); 
{$I FC fTrace}EP; {$ENDC} 

END; 

SgABCdat } 


FUNCTION TList.ManyAt(i, howMany: LONGINT): TList; 
VAR list: TList; 

BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
list := TList. CREATE(NIL, SELF.Heap, howMany) 
list. I nsManyAt(1, SELF, i, howMany); 
ManyAt := list; 
{$I1FC fTrace}EP; {$ENDC} 

END; 


sRes Dat } 
FUNCTION TList.MemberBytes: INTEGER; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
MemberBytes := 4; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
FUNCTION TList.PopLast: TObj ect; 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
PopLast := SELF. Last 
SELF. Del Last (FALSE); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$5 sResDat} 
FUNCTION TList.Pos(after: LONGINT; object: TObject): LONGINT; 
VAR y: TObj ect; 
s: TListScanner; 


BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
Pos := after; 
s := SELF.ScannerFrom after, scanForward) 


WHILE s.Scan(y) DO 
IF object = y THEN 
BEGIN 
Pos := s. position; 
s. Done; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
PROCEDURE TList. PutAt(i: LONGINT; object: TObject; freeOld: BOOLEAN) 
VAR pObject: TPObj ect; 
oldObject: TObject; 


$1 FC fTrace}BP( 4); {$ENDC} 

$1FC fCheckl ndices} 

F fCheckl ndices THEN 
SELF. Checkl ndex(i); 

{$ENDC} 


—AaASs 


{pObject := TPObj ect(SELF. Addr Member(i)); but for speed... } 


IF i > SELF. holeStart THEN 
i :=i + SELF. holeSize 
pObject := TPObj ect(TpLONGI NT(SELF)* + SELF.dynStart + (4 * (i - 1))); 


ol dObject := pObject’; 
pObject* := object 


IF freeOld THEN 
IF object <> oldObject THEN 
Free( ol dObj ect); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$5 sRes Dat} 
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FUNCTION TList.Scanner: TListScanner 

BEGIN 
{$IFC fTrace}BP( 2); {$ENDC} 
Scanner := TListScanner. CREATE(NIL, SELF, 0, scanForward); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$5 sResDat} 


FUNCTION TList.ScannerFrom(firstToScan: LONGINT; scanDirection: TScanDirection): TListScanner; 
BEGIN 
{$IFC fTrace}BP( 2); {$ENDC} 
ScannerFrom:= TListScanner. CREATE(NIL, SELF, firstToScan, scanDirecti on); 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$$ slnitl} 
{$1FC compatibleLists} {For Ti ndexList. Class} 
BEGIN 
cList := THISCLASS; 
{$ENDC} 
END; 
{$$ SgCLAres} 


METHODS OF TArray; 


{$5 sResDat} 
FUNCTION TArray.CREATE(object: TObject; heap: THeap; initialSlack, bytesPerRecord: INTEGER): TArray; 
BEGIN 
{$IFC fTrace}BP(1); {$ENDC} 
1F ODD( bytesPerRecord) THEN 
bytesPerRecord := bytesPerRecord + 1; 
IF object = NIL THEN 
object := NewDynObject( heap, THISCLASS, initialSlack * bytesPerRecord) 
SELF := TArray(TCollection, CREATE(object, heap, initialSlack)) 
SELF.recordBytes := bytesPerRecord 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods } 
{$8 SgCLAdbg} 
PROCEDURE TArray.Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
SUPERSELF. Fields(Field); 
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Field('recordBytes: INTEGER’); 
END; 
{$S SgCLAres} 
{$ENDC} 


{$1 FC fDebugMet hods} 

{$8 SgCLAdbg} 

PROCEDURE TArray.Debug(numlLevels: INTEGER; memberTypeStr: $255) 
VAR s: TArrayScanner 


pRecord: Ptr; 

i: | NTEGER; 
j: I NTEGER; 
str: $255: 
hexOrd: $8; 


PROCEDURE Suppl yMember( PROCEDURE Field(nameAndType: $255)); 
BEGIN 


Field(Concat(str, ': ', memberTypeStr)); 
END; 
BEGIN 
SUPERSELF. Debug(numLevels, ''); { this prints other fields of the array } 
IF (numLevels > 1) OR ((numLevels = 1) AND (memberTypeStr <> '')) THEN 
BEGIN 
WStr('{ '): 
i := 0; 
s := SELF. Scanner 


IF s.position = SELF. holeStart THEN 
WreStr(' <=HOLE=> ') 
WHILE s.Scan(pRecord) DO 
BEGIN 
IF i > 0 THEN 
WStr(', '): 
i:=i +41; 
IntToStr(i, @str); 
|[F memberTypeStr = '' THEN 
BEGIN 
str := CONCAT(str, ': '); 
FOR j := 0 TO SELF.recordBytes-1 DO 
BEGIN 
LI nt ToHex( TPByte( ORD( pRecord)+j)*, @hexOrd) 
str := CONCAT(str, Copy(hexOrd, 7, 2)); 
END; 
WrStr(str); 
END 
ELSE 


WriteDRecord(numLevels - 1, @pRecord, 0, Suppl yMember) 
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001047 
001048 
001049 
001050 
001051 


{$8 


{$8 


{$8 
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IF s. position = SELF. holeStart THEN 
WStr(', <=HOLE=> '): 
END; 
WrStr(' }'); 
END; 
END; 
{$S SgCLAres} 
{$ENDC} 


sRes Dat} 
FUNCTION TArray. At(i 
BEGIN 


LONGI NT): Ptr; 
{$1FC fTrace}BP( 3); {$ENDC} 
{$1 FC fCheckl ndices} 
IF fCheckl ndices THEN 

SELF. Checkl ndex(i); 
{$ENDC} 
{ At := 


Ptr (SELF. AddrMember(i)); but for speed... } 


IF i > SELF. holeStart THEN 
i :=i + SELF. holeSize 


At := 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 

PROCEDURE 

BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
SELF. EditAt(1, -SELF. size); 
{$IFC fTrace}EP; {$ENDC} 


TArray. Del All 


END; 


SgABCdat } 
PROCEDURE TArray. Del At(i: 
BEGIN 
{$I1FC fTrace}BP(4); {$ENDC} 
SELF. EditAt(i, -1); 
{$I1FC fTrace}EP; {$ENDC} 


LONGI NT) ; 


END; 


SgABCdat } 
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{$5 


{$8 


{$8 
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PROCEDURE TArray. Del First; 
BEGIN 

{$IFC fTrace}BP( 3); {$ENDC} 

SELF. Del At(1); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 

PROCEDURE TArray. Del Last 

BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
SELF. Del At( SELF. size) 
{$I1FC fTrace}EP; {$ENDC} 

END; 


SgABCdat } 
PROCEDURE TArray. Del ManyAt(i, howMany: LONGI NT) 
VAR j: INTEGER; 

BEGIN 

{$IFC fTrace}BP( 4); {$ENDC} 

1F howMany > 0 THEN 

SELF. EditAt(i, -howMany); 

{$1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TArray.Each( PROCEDURE DoToRecord(pRecord: Ptr)); 
VAR holeStart: INTEGER 


offset: INTEGER 
recordBytes: I NTEGER; 
j: | NTEGER; 


BEGIN 
{$IFC fTrace}BP( 4); {$ENDC} 
holeStart := SELF. holeStart; 
offset := SELF. dynStart; 
recordBytes := SELF.recordBytes 
FOR j := 0 TO SELF.size - 1 DO 
BEGIN 
1F j = holeStart THEN 
offset := offset + recordBytes * SELF. holeSize 
DoToRecord( Ptr( TpLONGI NT(SELF)* + offset)); 
offset := offset + recordBytes 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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001100 

001101 

001102 {$8 SgABCdat } 

001103 FUNCTION TArray. First: Ptr; 

001104 BEGIN 

001105 {$I1FC fTrace}BP( 3); {$ENDC} 

001106 First := SELF.At(1); 

001107 {$1FC fTrace}EP; {$ENDC} 

001108 END; 

001109 

001110 

001111 {$$ sResDat} 

001112 PROCEDURE TArray.GetAt(i: LONGINT; pRecord: Ptr); 
001113 BEGIN 

001114 {$I1FC fTrace}BP( 4); {$ENDC} 

001115 {$1 FC fCheckl ndices} 

001116 IF fCheckIl ndices THEN 

001117 SELF. Checkl ndex(i); 

001118 {$ENDC} 

001119 

001120 XferLeft(Ptr(SELF.AddrMember(i)), pRecord, SELF. recordBytes) 
001121 {$1FC fTrace}EP; {$ENDC} 

001122 END: 

001123 

001124 

001125 {$$ sResDat} 

001126 PROCEDURE TArray.InsAt(i: LONGINT; pRecord: Ptr); 
001127 BEGIN 

001128 {$IFC fTrace}BP( 4); {$ENDC} 

001129 SELF. EditAt(i, 1); 

001130 SELF. PutAt(i, pRecord) 

001131 {$1FC fTrace}EP; {$ENDC} 

001132 END; 

001133 

001134 

001135 {$$ sResDat} 

001136 PROCEDURE TArray.InsFirst(pRecord: Ptr); 
001137 BEGIN 

001138 {$1 FC fTrace}BP(3); {$ENDC} 

001139 SELF. I nsAt(1, pRecord) 

001140 {$I1FC fTrace}EP; {$ENDC} 

001141 END: 

001142 

001143 

001144 {$$ sResDat} 

001145 PROCEDURE TArray.InsLast(pRecord: Ptr) 
001146 BEGIN 

001147 {SI FC fTrace}BP( 3); {$ENDC} 
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SELF. I nsAt(SELF.size + 1, pRecord); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
FUNCTION TArray.Last: Ptr; 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
Last := SELF. At(SELF. size); 
{$IFC fTrace}EP; {$ENDC} 
END: 


{$$ SgABCdat } 
FUNCTION TArray. ManyAt(i, howMany: LONGINT): TArray; 
VAR arr: TArray 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
arr := TArray.CREATE( NIL, SELF.Heap, howMany, SELF. recordBytes); 
arr. I nsManyAt(1, SELF, i, howMany); 
ManyAt := arr; 
{$I1FC fTrace}EP; {$ENDC} 
END: 


{$S sResDat} 
FUNCTION TArray.MemberBytes: INTEGER 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
MemberBytes := SELF.recordBytes; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
FUNCTION TArray.Pos(after: LONGINT; pRecord: Ptr): LONGI NT 
VAR y: Ptr; 
gs: TArrayScanner 


FUNCTION EqualRecords(p, q: Ptr; n: INTEGER): BOOLEAN; {n is even} 
VAR i: INTEGER; 
BEGIN 
Equal Records := FALSE; 
i := 0; 
WHILE i <n DO 
BEGIN 
1F TpINTEGER(ORD(p) + i)* <> TpI NTEGER(ORD(q) + i)* THEN 
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EXI T( Equal Records); 
i :=i + 2; 
END; 
Equal Records := TRUE; 
END; 


BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
Pos := after; 
s := SELF.ScannerFrom after, scanForward) 
WHILE s.Scan(y) DO 
1F Equal Records(pRecord, y, SELF.recordBytes) THEN 
BEGIN 
Pos := s. position; 
s. Done; 


END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


sRes Dat } 
PROCEDURE TArray. PutAt(i: LONGINT; pRecord: Ptr); 
BEGIN 

{$I1FC fTrace}BP( 4); {$ENDC} 

{$1 FC fCheckl ndices} 

IF fCheckl ndices THEN 

SELF. Checkl ndex(i); 
{$ENDC} 


XferLeft(pRecord, Ptr(SELF.AddrMember(i)), SELF. recordBytes) 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 

FUNCTION TArray. Scanner: TArrayScanner 

BEGIN 
{$1FC fTrace}BP( 2); {$ENDC} 
Scanner := TArrayScanner. CREATE(NIL, SELF, 0, scanForward); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


SgABCdat } 


FUNCTION TArray.ScannerFrom(firstToScan: LONGINT; scanDirection: TScanDirecti on) 


BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
ScannerFrom:= TArrayScanner.CREATE(NIL, SELF, firstToScan, scanDirection); 
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001244 {$I1FC fTrace}EP; {$ENDC} 

001245 END; 

001246 

001247 

001248 {$$ slnit1} 

001249 {$1FC compatibleLists} {For TDynamicArray. Class} 
001250 BEGIN 

001251 cArray := THISCLASS; 


001252 {$ENDC} 
001253 END; 


001254 

001255 

001256 METHODS OF TString 

001257 

001258 

001259 {$$ sResDat} 

001260 FUNCTION TString. CREATE(object: TObject; heap: THeap; initialSlack: INTEGER): TString 
001261 BEGIN 

001262 {$I1FC fTrace}BP(1); {$ENDC} 

001263 1F ODD(initial Slack) THEN 

001264 initialSlack := initialSlack + 1; 

001265 IF object = NIL THEN 

001266 object := NewDynObject( heap, THISCLASS, initial Sl ack); 
001267 SELF := TString(TCollection. CREATE(object, heap, initial Slack)); 
001268 {$I1FC fTrace}EP; {$ENDC} 

001269 END; 

001270 

001271 

001272 {$1 FC fDebugMet hods} 

001273 {$8 SgCLAdbg} 

001274 PROCEDURE TString. Debug(numLevels: INTEGER; memberTypeStr: $255); 
001275 VAR s: TStringScanner; 

001276 ch: CHAR; 

001277 str: $8; 

001278 BEGIN 

001279 SUPERSELF. Debug(numLevels, ''); { this prints other fields of the list } 
001280 1F numLevels > 0 THEN 

001281 BEGIN 

001282 WStr(''''): 

001283 s := SELF. Scanner 

001284 IF s. position = SELF. holeStart THEN 

001285 Wr Str(' <=HOLE=>' ) 

001286 str :='x's 

001287 WHILE s.Scan(ch) DO 

001288 BEGIN 

001289 str[1] := ch; 

001290 WrStr(str); 

001291 IF s. position = SELF. holeStart THEN 
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{$8 


{$8 
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Wr Str(' <=HOLE=>' ) 
END; 
WStr(''''): 
END; 
END; 
{$S SgCLAres} 
{$ENDC} 


SgCLAres} 
FUNCTION TString.At(i: LONGINT): CHAR 
BEGIN 

{$1FC fTrace}BP( 3); {$ENDC} 

{$1FC fCheckl ndices} 

IF fCheckl ndices THEN 

SELF. Checkl ndex(i); 
{$ENDC} 


IF i > SELF. holeStart THEN 
i :=i + SELF. holeSize 
At := TpPAOC( TpLONGINT(SELF)* + SELF. dynStart) *[i] 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 

PROCEDURE TString. Del All; 

BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
SELF. EditAt(1, -SELF.size); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


SgCLAres} 
PROCEDURE TString. Del At(i: LONGI NT) 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
SELF. EditAt(i, -1); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 
PROCEDURE TString. Del First; 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
SELF. Del At(1); 
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{$1FC fTrace}EP; {$ENDC} 


END; 

SgCLAres} 

PROCEDURE TString. Del Last; 

BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
SELF. Del At( SELF. size) 
{$I1FC fTrace}EP; {$ENDC} 

END; 

SgCLAres} 


PROCEDURE TString. Del ManyAt(i, howMany: LONGI NT); 
VAR j: INTEGER; 

BEGIN 

{$IFC fTrace}BP( 4); {$ENDC} 

1F howMany > 0 THEN 

SELF. Edi tAt(i, -howMany); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 
PROCEDURE TString. Draw(i: LONGINT; howMany: INTEGER); 
VAR beforeHole: INTEGER 
pWord1: TpI NTEGER 
BEGIN 
{$IFC fTrace}BP( 4); {$ENDC} 
beforeHole := Min(SELF.holeStart - (i - 1), howMany) 
pWord1 := TpI NTEGER( TpLONGI NT(SELF)* + SELF. dynStart); 
IF beforeHole > 0 THEN 
DrawLText(pWord1, i - 1, beforeHole) 
1F beforeHole < howMany THEN 
DrawLText(pWord1, SELF. holeStart + SELF. holeSize - Min(beforeHole, 0), 
howMany - Max(beforeHole, 0)); 
{$1FC fTrace}EP; {$ENDC} 
END; 


sRes Dat } 
FUNCTION TString.Width(i: LONGINT; howMany: INTEGER): INTEGER 
VAR beforeHole: INTEGER 
pWord1: TpI NTEGER 
total Width: INTEGER 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
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001388 beforeHole := Min(SELF.holeStart - (i - 1), howMany) 
001389 pWord1 := TpI NTEGER(TpLONGI NT( SELF) * + SELF. dynStart) 
001390 total Width := 0; 

001391 I1F beforeHole > 0 THEN 

001392 total Width := TextWidth(pWord1, i - 1, beforeHole); 
001393 1F beforeHole < howMany THEN 

001394 total Width := total Width + TextWidth(pWord1, SELF. holeStart + SELF. holeSize - Min(beforeHole, 0) 
001395 howMany - Max(beforeHole, 0)) 
001396 Width := total Width: 

001397 {$I1FC fTrace}EP; {$ENDC} 

001398 END; 

001399 

001400 

001401 {$8 SgCLAres} 

001402 PROCEDURE TString. Each( PROCEDURE DoToCharacter(character: CHAR) ) 
001403 VAR holeStart: INTEGER 

001404 offset: INTEGER; 

001405 j: INTEGER; 

001406 pChars: TpPAOC; 

001407 BEGIN 

001408 {$I1FC fTrace}BP( 4); {$ENDC} 

001409 holeStart := SELF. hol eStart; 

001410 pChars := TpPAOC( TpLONGI NT(SELF)* + SELF. dynStart); 
001411 offset := 1: 

001412 FOR j := 0 TO SELF.size - 1 DO 

001413 BEGIN 

001414 1F j = holeStart THEN 

001415 offset := offset + SELF. holeSize 

001416 DoToCharacter(pChars*[offset]); 

001417 offset := offset + 1; 

001418 END; 

001419 {$IFC fTrace}EP; {$ENDC} 

001420 END; 

001421 

001422 

001423 {$8 SgCLAres} 

001424 FUNCTION TString. First: CHAR 

001425 BEGIN 

001426 {SIFC fTrace}BP( 3); {$ENDC} 

001427 First := SELF. At(1) 

001428 {$I1FC fTrace}EP; {$ENDC} 

001429 END; 

001430 

001431 

001432 {$8 SgCLAres} 

001433 PROCEDURE TString.InsAt(i: LONGINT; character: CHAR) 
001434 VAR pPAOC: TpPAOC 

001435 BEGIN 
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001436 
001437 
001438 
001439 
001440 
001441 
001442 
001443 
001444 
001445 
001446 
001447 
001448 
001449 
001450 
001451 
001452 
001453 
001454 
001455 
001456 
001457 
001458 
001459 
001460 
001461 
001462 
001463 
001464 
001465 
001466 
001467 
001468 
001469 
001470 
001471 
001472 
001473 
001474 
001475 
001476 
001477 
001478 
001479 
001480 
001481 
001482 
001483 


{$8 


{$8 


{$8 


{$5 


Apple Lisa Computer Technical Information 


{$1 FC fTrace}BP( 4); {$ENDC} 
SELF. EditAt(i, 1); 


pPAOC : = TpPAOC( TpLONGI NT(SELF)* + SELF. dynStart); 
pPAOC*[i] := character 
{$IFC fTrace}EP; {$ENDC} 

END; 


SgCLAres} 
PROCEDURE TString.InsFirst(character: CHAR) 
BEGIN 

{$1FC fTrace}BP( 3); {$ENDC} 

SELF.I nsAt(1, character); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 
PROCEDURE TString.InsLast(character: CHAR); 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
SELF.I nsAt(SELF.size + 1, character); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


sRes Dat } 
PROCEDURE TString.InsPStrAt(i: LONGINT; pStr: TPString) 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
SELF. EditAt(i, Length(pStr%*)); 
XferLeft(Ptr(ORD(pStr) +1), Ptr(SELF.AddrMember(i)), Length(pStr%)); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 
FUNCTION TString.Last: CHAR; 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
Last := SELF. At(SELF. size); 
{$1FC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 
FUNCTION TString. ManyAt(i, howMany: LONGINT): TString 
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VAR str: TString 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
str := TString. CREATE(NIL, SELF.Heap, howMany); 
str. I nsManyAt(1, SELF, i, howMany) 
ManyAt := str; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


sRes Dat } 
FUNCTION TString.MemberBytes: INTEGER 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
MemberBytes := 1; 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 


FUNCTION TString.Pos(after: LONGINT; character: CHAR) 


VAR y: CHAR; 
s: TStringScanner 
BEGIN 
{$IFC fTrace}BP( 3); {$ENDC} 
Pos := after; 
s := SELF.ScannerFrom after, scanForward) 
WHILE s.Scan(y) DO 
1F y = character THEN 
BEGIN 
Pos := s. position; 
s. Done; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 


PROCEDURE TString. PutAt(i: LONGINT; character: CHAR); 


VAR pPAOC: TpPAOC 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
{$IFC fCheckl ndices} 
IF fCheckl ndices THEN 
SELF. Checkl ndex(i); 
{$ENDC} 


IF i > SELF. holeStart THEN 


LONGI NT; 
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{$5 


{$8 


{$8 


{$8 


Apple Lisa Computer Technical Information 


i :=i + SELF. holeSize 


pPAOC : = TpPAOC( TpLONGI NT(SELF)* + SELF. dynStart); 
pPAOC*[i] := character 
{$IFC fTrace}EP; {$ENDC} 


END: 

SgCLAres} 

FUNCTION TString.Scanner: TStringScanner 

BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
Scanner := TStringScanner.CREATE( NIL, SELF, 0, scanForward); 
{$SIFC fTrace}EP; {$ENDC} 

END: 

SgCLAres} 


FUNCTION TString.ScannerFromfirstToScan: LONGINT; scanDirection: TScanDirecti on) 


BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
ScannerFrom:= TStringScanner. CREATE(NIL, SELF, firstToScan, scanDirection); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


SgCLAres} 
PROCEDURE TString. ToPStr(pStr: TPString) 
BEGIN 
{$1 FC fTrace}BP( 3); {$ENDC} 
SELF. ToPStrAt(1, SELF.size, pStr); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgCLAres} 
PROCEDURE TString.ToPStrAt(i, howMany: LONGINT; pStr: TPString) 
BEGIN 

{$IFC fTrace}BP( 3); {$ENDC} 

{$1 FC fCheckl ndices} 

1F howMany > 255 THEN 

ABCBreak('ToPStrAt: Too many characters', howMany); 
{$ENDC} 
SELF. EditAt(i + howMany, 0); 


XferLeft(Ptr(SELF.AddrMember(i)), Ptr(ORD(pStr) +1), howMany) 


)) 
{$R-} pStr*[0] := CHAR(howMany); {$IFC fRngObj ect }{$R+}{$ENDC} 


{$I1FC fTrace}EP; {$ENDC} 
END; 


TStringScanner; 
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001580 

001581 

001582 {$S slnit1} 
001583 END; 

001584 {$8 SgCLAres} 


001585 

001586 

001587 METHODS OF TFile; 

001588 

001589 

001590 {$$ sResDat} 

001591 FUNCTION TFile. CREATE(object: TObject; heap: THeap; itsPath: TFilePath; 
001592 itsPassword: TPassword): TFile: 
001593 VAR pPath: TPPat hname 

001594 error: INTEGER; 

001595 {$1FC LibraryVersion <= 20} 

001596 fsinfo: FS Info; 

001597 {$ELSEC} 

001598 fsi nfo: Q Info; 

001599 {$ENDC} 

001600 itsScanners: TList; 

001601 BEGIN 

001602 {$I1FC fTrace}BP(1); {$ENDC} 

001603 IF object = NIL THEN 

001604 object := NewObject(heap, THISCLASS) 
001605 SELF := TFile(TCollection. CREATE(object, heap, 0)); {Just to initialize those ignored fields} 
001606 pPath := @itsPath; 

001607 {$1FC LibraryVersion <= 20} 

001608 Lookup(error, pPath*, fsinfo) 

001609 {$ELSEC} 

001610 Quick _Lookup(error, pPath*, fsInfo) 
001611 {$ENDC} 

001612 

001613 itsScanners := TList.CREATE(NIL, heap, 0) 
001614 WITH SELF DO 

001615 BEGIN 

001616 dynStart := MAXINT; 

001617 1F error > 0 THEN 

001618 size := 0 

001619 ELSE 

001620 size := fsinfo.size 

001621 path := itsPath; 

001622 password := itsPassword 

001623 scanners := itsScanners 

001624 END; 

001625 {$I1FC fTrace}EP; {$ENDC} 

001626 END; 

001627 
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{$5 sResDat} 


PROCEDURE TFile. Free: {Free frees the scanners as well } 


BEGIN 
{$1FC fTrace}BP(5); {$ENDC} 
SELF. scanners. Free 
SUPERSELF. Free; 
{$1FC fTrace}EP; {$ENDC} 
END; 
{$S SgCLAres} 


{$1 FC fDbgObj ect } 
{$8 SgCLAdbg} 
FUNCTION TFile.Clone( heap: THeap): TObj ect; 
BEGIN 
ABCBreak('A TFile cannot Clone', 0); 
END; 
{$S SgCLAres} 
{$ENDC} 


{$1 FC fDebugMet hods} 

{$8 SgCLAdbg} 

PROCEDURE TFile. Fields( PROCEDURE Field(nameAndType: $255)); 

BEGIN 
SUPERSELF. Fields( Field); 
Field(' path: STRING[255]'); 
Field(' password: STRING[32]'); 
Field('scanners: TList'); 

END; 

{$S SgCLAres} 

{$ENDC} 


{$S SgCLAcl d} 
PROCEDURE TFile. ChangePassword(VAR error: INTEGER; newPassword 


VAR pPath: TPPat hname; 
pPass: TPEName 
pNPass: TPEName; 

BEGIN 


{$1 FC fMaxTrace}BP(1); {$ENDC} 

{$I1FC fMaxTrace}EP; {$ENDC} 

{$1FC LibraryVersion <= 20} 

error := -1293; {warning: file is not password protected} 
{$ELSEC} 

pPath := @SELF. path; 

pPass := @SELF. password 


TPassword); 
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pNPass := @newPassword 


Change Password(error, pPath*, pPass*, pNPass%*) 


{$ENDC} 
1F error <= 0 THEN 
SELF. password := newPassword 
END; 
{$S SgCLAres} 


{$$ SgCLAcl d} 


PROCEDURE TFile. Delete(VAR error: INTEGER); 


VAR pPath: TPPat hname; 
{$1FC LibraryVersion > 20} 
pPass: TPEName 
{$ENDC} 

BEGIN 


{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
pPath := Q@SELF. path; 
{$1FC LibraryVersion <= 20} 
Kill _Object(error, pPath*); 
{$ELSEC} 
pPass := @SELF. password 
Kill Secure(error, pPath*, pPass%*); 
{$ENDC} 

END; 

{$S SgCLAres} 


{$$ sRes Dat} 


FUNCTION TFile. Exists(VAR error: INTEGER) 


{$1FC LibraryVersion <= 20} 


VAR refinfo: FS Info; 
{$ELSEC} 
VAR refinfo: Q Info; 
{$ENDC} 
pPath: TPPat hname; 
BEGIN 


{$1 FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
pPath := @SELF. path; 
{$1FC LibraryVersion <= 20} 
Lookup(error, pPath*, reflnfo); 
{$ELSEC} 
Quick _Lookup(error, pPath*, refinfo); 
{$ENDC} 
Exists := error <= 0: 
END; 


BOOLEAN; 
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{$S SgCLAres} 


SgABCdat } 
FUNCTION TFile. MemberBytes: INTEGER; 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
MemberBytes := 1; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgCLAcI d} 


PROCEDURE TFile.Rename(VAR error: INTEGER; newFil eName 


{the volume of newFileName is ignored} 


VAR pPath: TPPat hname 
vol: TFilePath; 
name: TFilePath; 
pEName: TPEname; 
{$1FC LibraryVersion > 20} 
pPass: TPEName; 
{$ENDC} 

BEGIN 


{$IFC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
pPath := @SELF. path; 
SplitFilePath(newFileName, vol, name); 
pEName := @name; 
{$1FC LibraryVersion <= 20} 
Rename Entry(error, pPath*, pEName%); 
{$ELSEC} 
pPass := @SELF. password 
Rename Secure(error, pPath*, pEName*, pPass%*) 
{$ENDC} 

END; 

{$$ SgCLAres} 


{$$ SgCLAcl d} 

FUNCTION TFile.Scanner: TFileScanner 

BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
Scanner := SELF.ScannerFrom(0, [fRead, fWrite]); 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$8 SgCLAres} 
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001772 {$$ sResDat} 


001773 FUNCTION TFile.ScannerFrom(firstToScan: LONGINT; manip: TAccesses): TFileScanner 
001774 VAR s: TFileScanner 

001775 BEGIN 

001776 {$IFC fTrace}BP( 2); {$ENDC} 

001777 s := TFileScanner.CREATE(NIL, SELF, manip) 
001778 s. Seek( first ToScan) 

001779 ScannerFrom:= s; 

001780 {$1FC fTrace}EP; {$ENDC} 

001781 END; 

001782 {$S SgCLAres} 

001783 

001784 

001785 {$S SgCLAcl d} 

001786 FUNCTION TFile. VerifyPassword(VAR error: INTEGER; password: TPassword): BOOLEAN 
001787 VAR pPath: TPPathname; 

001788 pPass: TPEName; 

001789 BEGIN 

001790 {$1 FC fMaxTrace}BP( 1); {$ENDC} 

001791 {$IFC fMaxTrace}EP; {$ENDC} 

001792 {$1FC LibraryVersion <= 20} 

001793 error := -1293; {warning file is not password protected} 
001794 VerifyPassword := TRUE; 

001795 {$ELSEC} 

001796 pPath := Q@SELF. path; 

001797 pPass := @password; 

001798 Verify_Password(error, pPath*, pPass%); 
001799 VerifyPassword := error <= 0; 

001800 {$ENDC} 

001801 END; 

001802 {$S SgCLAres} 

001803 

001804 

001805 {$S SgCLAcl d} 

001806 FUNCTION TFile. WhenModified(VAR error: INTEGER): LONGI NT 
001807 {$1FC LibraryVersion <= 20} 

001808 VAR refinfo: FS_Info; 

001809 {$ELSEC} 

001810 VAR refinfo: Q_I nfo; 

001811 {$ENDC} 

001812 pPath: TPPat hname; 

001813 BEGIN 

001814 {$1FC fMaxTrace}BP( 1); {$ENDC} 

001815 {$IFC fMaxTrace}EP; {$ENDC} 

001816 pPath := @SELF. path; 

001817 {$1FC LibraryVersion <= 20} 

001818 Lookup(error, pPath*, refinfo) 

001819 {$ELSEC} 
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Quick _Lookup(error, pPath*, refinfo); 
{$ENDC} 
IF error <= 0 THEN 
WhenModified := reflnfo. DTM 
ELSE 


WhenModified := -1:; 


END; 
{$S SgCLAres} 


{$S slniti} 
ND; 
{$$ SgCLAres} 


METHODS OF TScanner; 


{$5 sRes Dat} 
FUNCTION TScanner.CREATE( object: TObject; itsCollection: TColl ection; 
itsInitial Position: LONGINT; scanDirection: TScanDirection): TScanner 
BEGIN 
{$IFC fTrace}BP(1); {$ENDC} 
IF object = NIL THEN 
ABCBreak('TScanner. CREATE must be passed an already-allocated object by a subclass CREATE’, 0); 
SELF := TScanner( object); 


WITH SELF DO 
BEGIN 
collection := itsCollection; 
{$H-} position := Max(0, Min(collection,sizetl, itsInitialPosition)); {$H+} 
scanDone := FALSE; 


IF scanDirection = scanForward THEN 
BEGIN 
increment := 1; 
atEnd := position >= collection.size 
END 
ELSE 
BEGIN 
increment := -1: 
atEnd := position <= 1; 
END; 
END; 
SELF. Seek(itsInitial Position); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$1 FC fDebugMet hods} 


{$S SgCLAdbg} 


PROCEDURE TScanner. Fields( PROCEDURE Field(nameAndType: $255) ) 


BEGIN 


SUPERSELF. Fields(Field); 
Field('collection: TCollection'); 
Field(' position: LONGINT'); 
Field('increment: | NTEGER'); 
Field('scanDone: BOOLEAN'); 
Field('atEnd: BOOLEAN' ) 


END; 
{$S SgCLAres} 
{$ENDC} 


{$$ SgABCdat} 


FUNCTION TScanner. Advance( PROCEDURE DoToCurrent( another Member: 
VAR moreToScan: BOOLEAN 


BEGIN 


{$1FC fTrace}BP(1); {$ENDC} 


WITH SELF DO 


IF scanDone THEN 
moreToScan := FALSE {don't reassign nextObj ect} 


ELSE 


BEGIN 
1F atEnd THEN 


ELSE 


moreToScan := FALSE 


BEGIN 

moreToScan := TRUE: 

position := position + increment 
IF increment > 0 THEN 


atEnd := position >= collection.size 
ELSE 
atEnd := position <= 1; 
END; 
{$H-} DoToCurrent(moreToScan); {$H+} 
END; 
1F NOT moreToScan THEN 
SELF. Free; 
Advance := moreToScan; 


{$1FC fTrace}EP; {$ENDC} 


END; 


BOOLEAN) ): 
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SgABCdat } 

PROCEDURE TScanner. All ocate(slack: 

BEGIN 
{$1FC fTrace}BP( 2); {$ENDC} 
SELF. collection, StartEdit(sl ack); 
{$I1FC fTrace}EP; {$ENDC} 


LONGI NT); 


END; 


SgABCdat } 
PROCEDURE TScanner. Close 
BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TScanner. Compact; 
BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
SELF. collection. StopEdit; 
{$IFC fTrace}EP; {$ENDC} 
END: 


sRes Dat } 

PROCEDURE TScanner. Done 

BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
SELF.scanDone := TRUE; 
{$1FC fTrace}EP; {$ENDC} 

END: 


SgABCdat } 
PROCEDURE TScanner. Open; 
BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 

PROCEDURE TScanner. Reverse 

BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
SELF.increment := - SELF.increment; 
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{$1FC fTrace}EP; {$ENDC} 


{$5 sRes Dat} 
PROCEDURE TScanner. Seek(newPosition: LONGINT); 


BEGI 


{$H-} position 


END; 


N 
{$IFC fTrace}BP( 2); {$ENDC} 
WITH SELF DO 

BEGIN 
= Max(0, Min(collection.size+l, newPosition)); {$H+} 
atEnd := ((position >= collection.size) AND (increment > 0)) OR 
((position <= 1) AND (increment < 0)); 


END; 
{$1FC fTrace}EP; {$ENDC} 


{$$ SgABCdat } 
PROCEDURE TScanner.Skip(deltaPos: LONGI NT); 


BEGI 


END; 


N 

{$1FC fTrace}BP( 2); {$ENDC} 

SELF. Seek(SELF. position + deltaPos); 
{$I1FC fTrace}EP; {$ENDC} 


{$S slnit1} 


D; 


{$$ SgCLAres} 


METHODS 


OF TListScanner 


{$S sResDat} 
FUNCTION TListScanner.CREATE(object: TObject; itsList: TList; 


BEGI 


END; 


itsInitial Position: LONGINT; itsScanDirection: TScanDi rection) 
: TListScanner; 
N 
{$I1FC fTrace}BP(1); {$ENDC} 
IF object = NIL THEN 
object := NewOrRecycl edObj ect(mainHeap, THISCLASS, avail ListScanner); 
SELF := TListScanner(TScanner. CREATE(object, itsList, itsInitial Position, itsScanDirection)) 
{$I1FC fTrace}EP; {$ENDC} 
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{$$ sResDat} 
PROCEDURE TListScanner. Free 
BEGIN 
{$I1FC fTrace}BP(1); {$ENDC} 
RecycleObject(SELF, availListScanner); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S SgABCdat } 
PROCEDURE TListScanner. Append(object: TObject); 
BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
TList (SELF. collection). I nsAt(SELF. position + 1, object); 
SELF. position := SELF. position + 1; 


(***** removed the following line: .InsAt should have set the collection size 
{$H-} SELF.collection.size := Max(SELF.collection.size, SELF. position); {$H+} 
HARK K) 


{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
PROCEDURE TListScanner. Delete(freeOld: BOOLEAN); 
BEGIN 
{$IFC fTrace}BP( 2); {$ENDC} 
TList (SELF. collection). DelAt(SELF. position, freeOld); 
WITH SELF DO 
IF increment > 0 THEN 
position := position - 1; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
PROCEDURE TListScanner. Del eteRest(freeOld: BOOLEAN); 
BEGIN 
{$1FC fTrace}BP( 2); {$ENDC} 
WITH SELF DO 
IF increment > 0 THEN 
{$H- } TList(collection). Del ManyAt( position + 1, collection.,size - position, freeOld) 
ELSE 


TList(collection).Del ManyAt(1, position - 1, freeOld); {$H+} 
WITH SELF DO 
BEGIN 
collection.size := position; 
atEnd := TRUE; 
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002060 END; 

002061 {$I1FC fTrace}EP; {$ENDC} 

002062 END; 

002063 

002064 

002065 {$8 SgABCdat } 

002066 FUNCTION TListScanner. Obtain: TObject; 

002067 BEGIN 

002068 {$1FC fTrace}BP(1); {$ENDC} 

002069 Obtain := TList(SELF. collection). At( SELF. position); 

002070 {$I1FC fTrace}EP; {$ENDC} 

002071 END; 

002072 

002073 

002074 {$8 SgABCdat } 

002075 PROCEDURE TListScanner. Replace(object: TObject; freeOld: BOOLEAN); 
002076 BEGIN 

002077 {$IFC fTrace}BP( 2); {$ENDC} 

002078 TList (SELF. collection). PutAt(SELF. position, object, freeOld) 
002079 {$I1FC fTrace}EP; {$ENDC} 

002080 END; 

002081 

002082 

002083 {$$ sResDat} 

002084 FUNCTION TListScanner. Scan(VAR nextObject: TObject): BOOLEAN 
002085 VAR actIndex: LONGI NT; {an actual index into the list, INCLUDING the hole as part of the list} 
002086 (* 

002087 PROCEDURE AssignListScanVariable(anotherObj ect: BOOLEAN) 
002088 BEGIN 

002089 IF anotherObj ect THEN 

002090 next Object := TList(SELF.collection). At( SELF. position) 
002091 ELSE 

002092 next Object := NIL; 

002093 END; 

002094 

002095 BEGIN 

002096 {$I1FC fTrace}BP(1); {$ENDC} 

002097 Scan := SELF. Advance( Assi gnListScanVari able); 

002098 {$IFC fTrace}EP; {$ENDC} 

002099 END; 

002100 *) 

002101 VAR moreToScan: BOOLEAN 

002102 BEGIN {speedier version} 

002103 {$I1FC fTrace}BP(1); {$ENDC} 

002104 WITH SELF DO 

002105 IF scanDone THEN 

002106 moreToScan := FALSE {don't reassign nextObj ect} 
002107 ELSE 
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BEGIN 
1F atEnd THEN 
moreToScan := FALSE 
ELSE 
BEGIN 
moreToScan := TRUE: 
position := position + increment 
IF increment > 0 THEN 


atEnd := position >= collection.size 

ELSE 
atEnd := position <= 1; 

END; 

IF moreToScan THEN 

BEGIN 

IF position > collection. holeStart THEN 
actIindex := position + collection. holeSize 

ELSE 


actindex : osition; 


=p 
next Object := TPObj ect(TpLONGINT(collection)* + collection. dynStart 


+ (4 * (acti ndex - 1)))*; 


END 
ELSE 
nextObject := NIL; 
END; 
1F NOT moreToScan THEN 
SELF. Free; 
Scan := moreToScan: 
{$I FC fTrace}EP; {$ENDC} 
END; 
{$5 slnit1} 
BEGIN 
avail ListScanner := NIL; 


END; 
{$$ SgCLAres} 


METHODS OF TArrayScanner; 


{$8 SgABCdat } 
FUNCTION TArrayScanner.CREATE(object: TObject; itsArray: TArray; 
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{$8 


{$8 


{$$ 


{$8 
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itslnitial Position: LONGINT; itsScanDirection: TScanDirecti on) 
: TArrayScanner; 
BEGIN 
{$IFC fTrace}BP(1); {$ENDC} 
IF object = NIL THEN 
object := NewOrRecycl edObj ect(mainHeap, THISCLASS, avail ArrayScanner); 
SELF := TArrayScanner(TScanner. CREATE(object, itsArray, itsInitial Position, itsScanDirection) ) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 

PROCEDURE TArrayScanner. Free 

BEGIN 
{$IFC fTrace}BP(1); {$ENDC} 
RecycleObject(SELF, avail ArrayScanner); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


SgABCdat } 
PROCEDURE TArrayScanner.Append( pRecord: Ptr); 
BEGIN 

{$1FC fTrace}BP( 2); {$ENDC} 

TArray(SELF. collection). I nsAt(SELF. position + 1, pRecord); 
SELF. position := SELF. position + 1; 

{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TArrayScanner. Delete 
BEGIN 

{$I1FC fTrace}BP( 2); {$ENDC} 

TArray(SELF. collection). Del At( SELF. position); 
WITH SELF DO 

IF increment > 0 THEN 
position := position - 1; 

{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TArrayScanner. Del eteRest; 
BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
WITH SELF DO 
IF increment > 0 THEN 
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{$5 


{$8 


{$8 


Apple Lisa Computer Technical Information 


{$H- } TArray(collection). Del ManyAt( position + 1, collection.size - position) 
ELSE 


TArray(collection). Del ManyAt(1, position - 1); {$H+} 


WITH SELF DO 
BEGIN 
collection.size := position; 
atEnd := TRUE; 


END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 

FUNCTION TArrayScanner. Obtain: Ptr 

BEGIN 
{$1FC fTrace}BP(1); {$ENDC} 
Obtain := TArray(SELF.collection). At(SELF. position); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


SgABCdat } 

PROCEDURE TArrayScanner. Replace(pRecord: Ptr); 

BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
TArray(SELF. collection). PutAt(SELF. position, pRecord); 
{$IFC fTrace}EP; {$ENDC} 

END; 


SgABCdat } 
FUNCTION TArrayScanner.Scan(VAR pNextRecord: Ptr): BOOLEAN; 


PROCEDURE AssignArrayScanVariable(anotherRecord: BOOLEAN) 
BEGIN 
1F anotherRecord THEN 
pNextRecord := TArray(SELF. collection). At( SELF. position) 
ELSE 
pNextRecord := NIL; 
END; 


BEGIN 

{$I1FC fTrace}BP(1); {$ENDC} 

Scan := SELF, Advance( Assi gnArrayScanVari abl e) 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$8 slnit1} 
BEGIN 


avail ArrayScanner := NIL; 
END; 
{$$ SgCLAres} 


METHODS OF TStringScanner; 


{$8 SgABCdat } 
FUNCTION TStringScanner. CREATE(object: TObject; itsString: TString 


itsInitial Position: LONGINT; itsScanDirection 


: TStringScanner; 
BEGIN 
{$I1FC fTrace}BP(1); {$ENDC} 
IF object = NIL THEN 


TScanDi rection) 


object := NewOrRecycl edObj ect(mainHeap, THISCLASS, avail StringScanner) 
SELF := TStringScanner(TScanner.CREATE(object, itsString, itsInitial Position, itsScanDirection)); 


SELF. actual := 0; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
PROCEDURE TStringScanner. Free 
BEGIN 
{$I1FC fTrace}BP(1); {$ENDC} 
RecycleObject(SELF, avail StringScanner); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fDebugMet hods} 
{$8 SgCLAdbg} 
PROCEDURE TStringScanner. Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
SUPERSELF. Fields( Field); 
Field('actual: LONGINT' ) 
END; 
{$S SgCLAres} 
{$ENDC} 


{$$ SgABCdat} 
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PROCEDURE TStringScanner.Append(character: CHAR); 

BEGIN 
{$1 FC fTrace}BP( 2); {$ENDC} 
TString(SELF.collection).InsAt(SELF. position + 1, character); 
SELF. position := SELF. position + 1; 
{$I FC fTrace}EP; {$ENDC} 

END; 


SgABCdat } 
PROCEDURE TStringScanner. Del ete; 
BEGIN 
{$IFC fTrace}BP( 2); {$ENDC} 
TString(SELF. collection). Del At( SELF. position) 
WITH SELF DO 
IF increment > 0 THEN 
position := position - 1; 
{$I1FC fTrace}EP; {$ENDC} 


SgABCdat } 
PROCEDURE TStringScanner. Del eteRest; 
BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
WITH SELF DO 
IF increment > 0 THEN 


{$H- } TString(collection).DelManyAt(position + 1, collection.size - 
ELSE 


TString(collection).Del ManyAt(1, position - 1); {$H+} 


WITH SELF DO 
BEGIN 
collection.size := position; 
atEnd := TRUE; 
END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
FUNCTION TStringScanner. Obtain: CHAR 
BEGIN 
{$I1FC fTrace}BP(1); {$ENDC} 
Obtain := TString(SELF.collection). At(SELF. position); 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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{$$ SgABCdat } 
PROCEDURE TStringScanner. Repl ace(character: CHAR); 
BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
TString(SELF. collection). PutAt(SELF. position, character); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
FUNCTION TStringScanner.Scan(VAR nextChar: CHAR): BOOLEAN 


PROCEDURE AssignStringScanVari able(anotherChar: BOOLEAN) 
BEGIN 
IF anotherChar THEN 
nextChar := TString(SELF. collection). At(SELF. position) 
ELSE 
nextChar := CHAR(0); 
END; 


BEGIN 

{$I FC fTrace}BP(1); {$ENDC} 

Scan := SELF, Advance(AssignStringScanVari able); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sResDat} 

FUNCTION TStringScanner. ReadArray( heap: THeap; bytesPerRecord: INTEGER): TArray; 
VAR a: TArray; 

BEGI N 
{$IFC fTrace}BP( 2); {$ENDC} 
a:= TArray.CREATE(NIL, heap, 0, bytesPerRecord) 
XferContiguous(xRead, a, 2, SELF); 
ReadArray := a; 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ sRes Dat} 
FUNCTION TStringScanner. ReadNumber(numBytes: SizeOfNumber): LONGI NT; 
VAR v: 

RECORD 

CASE INTEGER OF 
1: (signExtension, short: INTEGER) 
2: (long: LONGI NT); 
END; 
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{$8 


{$8 


{$8 
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BEGIN 
{$1 FC fTrace}BP( 2); {$ENDC} 
v.long := 0; 


SELF. XferSequential(xRead, Ptr( ORD( @v) +4-numBytes), numBytes); 
IF numBytes=2 THEN 
IF v.short < 0 THEN 
v.SignExtension := -1; 
ReadNumber := v. long; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
FUNCTION TStringScanner. ReadObj ect(heap: THeap): TObj ect; 
VAR class: TClass 
object: TObject; 
BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
class := TClass(SELF. ReadNumber (4) ) 
object := NewObject(heap, class); 
object. Read( SELF); 
ReadObj ect := object; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TStringScanner. WiteArray(a: TArray) 
BEGI N 
{$I FC fTrace}BP( 2); {$ENDC} 
XferContiguous(xWrite, a, 2, SELF) 
{$SIFC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TStringScanner. WriteNumber(value: LONGINT; numBytes: SizeOf Number) 
BEGIN 
{$1FC fTrace}BP( 3); {$ENDC} 
SELF. XferSequential(xWrite, Ptr(ORD( @val ue) +4-numBytes), numBytes); 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TStringScanner. WriteObject(object: TObject); 
BEGIN 

{$I FC fTrace}BP( 2); {$ENDC} 
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SELF. WriteNumber(ORD(object.Class), 4); 
object. Wite( SELF); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TStringScanner. XferConti guous(whichWay: xReadWrite; collection: TColl ection) 
VAR numToXfer: INTEGER 
BEGIN {Transfer the size (as an INTEGER), class-specific fields, and members. 
Do not recur on the members. 
Do not transfer the class, the dynStart (=SizeOfClass), or the hole info (=zero). 
When reading, append the elements that are read 
This only works for contiguous objects up to 32K members in size. } 
{$1FC fTrace}BP( 3); {$ENDC} 
XferContiguous(whichWay, collection, 0, SELF); 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 
PROCEDURE TStringScanner. XferFields(whichWay: xReadWrite; object: TObject); 
BEGIN {Transfers the bits of a TObject, excluding the class pointer and any dynamic part} 
{$1FC fTrace}BP( 3); {$ENDC} 
SELF. XferSequenti al (whichWay, 
Ptr( ORD( TH( obj ect)*) + SIZEOF(TObject)), 
SizeOfClass(object.Class) - SI ZEOF(TObj ect)); 
{$IFC fTrace}EP; {$ENDC} 


SgABCdat } 
PROCEDURE TStringScanner. XferPString(whichWay: xReadWrite; pStr: TPString) 
VAR size: Byte 
BEGIN 
{$I1FC fTrace}BP( 4); {$ENDC} 
1F whichWay = xWrite THEN 
size := Length(pStr*); 
SELF. XferSequential(whichWay, @size, 1); 
SELF. XferSequential(whichWay, Ptr(ORD(pStr)+l), size) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 

PROCEDURE TStringScanner. XferRandom( whichWay: xReadWrite; pFirst: Ptr; numBytes: LONGI NT; 
mode: TlOMode; offset: LONGI NT); 

BEGIN 


Apple Lisa ToolKit 3.0 Source Code Listing -- 670 of 1012 


002492 
002493 
002494 
002495 
002496 
002497 
002498 
002499 
002500 
002501 
002502 
002503 
002504 
002505 
002506 
002507 
002508 
002509 
002510 
002511 
002512 
002513 
002514 
002515 
002516 
002517 
002518 
002519 
002520 
002521 
002522 
002523 
002524 
002525 
002526 
002527 
002528 
002529 
002530 
002531 
002532 
002533 
002534 
002535 
002536 
002537 
002538 
002539 


Apple Lisa Computer Technical Information 


{$1FC fTrace}BP(1); {$ENDC} 
CASE mode OF 
fAbsolute: SELF. Seek( offset); 
fRelative: SELF.Skip(offset); 
END; 
SELF. XferSequential(whichWay, pFirst, numBytes) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
PROCEDURE TStringScanner. XferSequential(whichWay: xReadWrite; pFirst: Ptr; numBytes: LONGINT); 
BEGIN 
{$I1FC fTrace}BP(1); {$ENDC} 
WITH SELF, collection DO 
BEGIN 
-} actual := Min(size - position, numBytes); {$H+} 
-} collection, EditAt(size + 1, 0); {$H+} {Maybe we should xfer in two steps instead} 
END; 
WITH SELF DO 
BEGIN 
{$H-} XferLeft(pFirst, Ptr(collection. AddrMember( position + 1)), actual); {$H+} 
position := position + actual 
atEnd := position = collection.size 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$H 
{$H 


{$S slnit1} 
BEGIN 


avail StringScanner := NIL; 


END; 
{$$ SgCLAres} 


METHODS OF TFileScanner 


{$5 sResDat} 
FUNCTION TFileScanner. CREATE(object: TObject; itsFile: TFile; manip: TAccesses): TFileScanner; 
BEGIN 
{$1FC fTrace}BP( 5); {$ENDC} 
IF object = NIL THEN 
object := NewObject(itsFile.Heap, THI SCLASS) 
SELF := TFileScanner(TScanner. CREATE(object, itsFile, 0, scanForward)) 
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SELF.actual := 0; 
SELF. accesses := 
SELF. Open; 
TFile(SELF.collection).scanners.InsLast (SELF) 
{$I1FC fTrace}EP; {$ENDC} 

END; 

{$S SgCLAres} 


mani p; 


{$1 FC fDebugMet hods} 
{$5 SgCLAdbg} 


PROCEDURE TFileScanner. Fields( PROCEDURE Field(nameAndType 


BEGIN 
SUPERSELF. Fields( Field); 
Field('accesses: Byte') 
Field('refnum: INTEGER’) 
Field('error: INTEGER’) 

END; 

{$S SgCLAres} 

{$ENDC} 


SgABCdat } 


$255)); 


PROCEDURE TFileScanner.FreeObject; {use FreeObject, rather than Free, so that we close the 
file if the user says fs.FreeObject (as in 
TDocManager. OpenSaved), as well as fs. Free} 


BEGIN 
{$1 FC fTrace}BP(5); {$ENDC} 
SELF. Close; 


TFile(SELF.collection).scanners. Del Object(SELF, FALSE); 


SUPERSELF. FreeObj ect; 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgABCdat } 


PROCEDURE TFil eScanner. Free; {Free frees the TFile as well, if no other scanners still exist} 


VAR itsFile: TFile: 

BEGIN 

{$1FC fTrace}BP(5); {$ENDC} 

itsFile := TFile(SELF.collection); 
SELF. FreeQbj ect; 

IF itsFile.scanners.size = 0 THEN 

itsFile. Free; 

{$I1FC fTrace}EP; {$ENDC} 
END; 
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002589 PROCEDURE TFileScanner. All ocate(slack: LONGI NT); 
002590 VAR fslInfo: FS_Info; 

002591 pages: LONGI NT 

002592 actual: LONGI NT; 

002593 newErr: INTEGER; 

002594 BEGIN 

002595 {$I1FC fTrace}BP( 2); {$ENDC} 

002596 Info(newErr, SELF.refnum, fsinfo) 

002597 WITH fsinfo DO 

002598 pages := ((size + slack + | pSize - 1) DIV IpSize) - ((pSize + IpSize - 1) DIV I pSize) 
002599 IF pages > 0 THEN 

002600 Allocate(newErr, SELF.refnum, TRUE, pages, actual); 
002601 IF (newErr <= 0) AND (actual < pages) THEN 
002602 Allocate(newErr, SELF.refnum, FALSE, pages - actual, actual) 
002603 {$H-} LatestError(newErr, SELF.error); {$H+} 
002604 {$I1FC fTrace}EP; {$ENDC} 

002605 END: 

002606 

002607 

002608 {$8 SgABCdat } 

002609 PROCEDURE TFileScanner. Close 

002610 VAR newErr: INTEGER 

002611 BEGIN 

002612 {$IFC fTrace}BP( 2); {$ENDC} 

002613 Close Object(newErr, SELF. ref num) 

002614 {$H-} LatestError(newErr, SELF.error); {$H+} 
002615 {$I1FC fTrace}EP; {$ENDC} 

002616 END; 

002617 

002618 

002619 {$8 SgABCdat } 

002620 PROCEDURE TFil eScanner. Compact 

002621 VAR newErr: INTEGER 

002622 BEGIN 

002623 {$IFC fTrace}BP( 2); {$ENDC} 

002624 Compact(newErr, SELF. refnum); 

002625 {$H-} LatestError(newErr, SELF.error); {$H+} 
002626 {$I1FC fTrace}EP; {$ENDC} 

002627 END; 

002628 

002629 

002630 {$8 SgABCdat } 

002631 PROCEDURE TFileScanner. Delete 

002632 BEGIN 

002633 {$I1FC fTrace}BP( 2); {$ENDC} 

002634 SELF. Ski p(- 1) 

002635 {$IFC fTrace}EP; {$ENDC} 
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END; 


{$$ SgABCdat } 
PROCEDURE TFileScanner. DeleteRest:; 
VAR newErr: INTEGER; 
BEGIN 
{$1FC fTrace}BP( 2); {$ENDC} 
Truncate(newErr, SELF. ref num) 
{$H-} LatestError(newErr, SELF.error); {$H+} 
WITH SELF DO 
BEGIN 
collection.size := position; 
atEnd := TRUE; 


END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TFileScanner. Append(character: CHAR) 

BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
SELF. XferSequential(xWrite, Ptr(ORD( @character)+1), 1) 
{$IFC fTrace}EP; {$ENDC} 

END; 


{$$ SgABCdat } 
FUNCTION TFileScanner. Obtain: CHAR 
VAR character: CHAR 
BEGIN 
{$1 FC fTrace}BP(1); {$ENDC} 
SELF. XferRandom( xRead, Ptr(ORD( @character) + 1), 1, fRelative, -1) 
Obtain := character 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ sResDat} 
{$1FC LibraryVersion <= 20} 
PROCEDURE TFil eScanner. Open; 
VAR pPath: TPPat hName; 
itsFile: TFile; 
BEGIN 
{$IFC fTrace}BP( 2); {$ENDC} 
itsFile := TFile(SELF.collection); 
pPath := @itsFile. path; 
{$H-} Open(SELF.error, pPath*, SELF.refnum, MSet(SELF.accesses)); {$H+} 
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1F (SELF.error = 948) and (fWrite in SELF.accesses) then 
BEGIN 
{$H- } Make File(SELF.error, pPath*, 0); 
IF SELF.error <= 0 then 
Open(SELF.error, pPath*, SELF.refnum, MSet(SELF.accesses)); {$H+} 


END; 
{$I1FC fTrace}EP; {$ENDC} 


END; 
{$ELSEC} 
PROCEDURE TFil eScanner. Open; 
VAR pPath: TPPat hName; 
itsFile: TFile; 
pPass: TPEName 
BEGIN 


{$I1FC fTrace}BP( 2); {$ENDC} 
itsFile := TFile(SELF. collection); 
pPath := @itsFile. path; 
pPass := @itsFile. password 
{$H-} Open _Secure(SELF.error, pPath*, SELF.refnum, MSet(SELF.accesses), pPass%); 
IF (SELF.error = 948) and (fWrite in SELF.accesses) then 
BEGIN 
{$H- } Make Secure(SELF.error, pPath*, pPass%) 
IF SELF.error <= 0 then 
Open Secure(SELF.error, pPath*, SELF.refnum, MSet(SELF. accesses), 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
{$ENDC} 


{$$ SgABCdat } 
PROCEDURE TFileScanner. Replace(character: CHAR) 
BEGIN 
{$I FC fTrace}BP( 2); {$ENDC} 
SELF. XferRandom( xWrite, Ptr(ORD(@character) + 1), 1, fRelative, -1); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ SgABCdat } 
FUNCTION TFileScanner.Scan(VAR nextChar: CHAR): BOOLEAN 


PROCEDURE AssignFileScanVariable(anotherChar: BOOLEAN) 
BEGIN 
IF anotherChar THEN 
SELF. XferSequential(xRead, Ptr(ORD( @nextChar) + 1), 1) 
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ELSE 
nextChar := CHAR(0); 
END; 


BEGIN 

{$I1FC fTrace}BP(1); {$ENDC} 

Scan := SELF, Advance( Assi gnFileScanVari able); 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ sResDat} 

PROCEDURE TFil eScanner. Seek(newPosition: LONGI NT); 
VAR dummy: INTEGER; 

BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
SELF. XferRandom(xRead, @dummy, 0, fAbsolute, newPosition); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ SgABCdat } 

PROCEDURE TFileScanner. Ski p(deltaPos: LONGI NT) 
VAR dummy: INTEGER; 

BEGIN 
{$I1FC fTrace}BP( 2); {$ENDC} 
SELF. XferRandom(xRead, @dummy, 0, fRelative, deltaPos); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$8 sResDat} 
PROCEDURE TFileScanner. XferRandom( whichWay: xReadWrite; pFirst: 


Ptr; numBytes: LONGI NT; 


mode: TlOMode; offset: LONGI NT); 


VAR newErr: INTEGER; 
os Mode: | OMode; 
fsinfo: FS Info; 
sched_err: INTEGER; 

BEGIN 

{$I1FC fTrace}BP(4); {$ENDC} 

osMode := | OMode( mode); 


WITH SELF DO {$H- } 
IF error <= 0 THEN 
BEGIN 
CASE whichWay OF 
xRead: BEGIN 
Sched Class(sched_err, FALSE); 


Read Data(newErr, refnum, ord(pFirst), numBytes, actual, osMode, offset) 
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Sched_Class(sched_err, TRUE); 
END; 
xWrite: BEGIN 
Sched Class(sched_err, FALSE); 
Write Data(newErr, refnum, ord(pFirst), numBytes, actual, osMode, offset) 
Sched_Class(sched_err, TRUE); 
collection.size := Max(position + actual, collection. size) 


END; 
END; 
IF (newErr = 956) OR (newErr = 963) OR (newErr = 883) OR (newErr = 882) OR 
(newErr = 848) THEN {EOF} 
newErr := 0; 


1F mode = fSequential THEN {do it fast} 
position := position + actual 

ELSE {play it safe} 
BEGIN 
Info(newErr, refnum, fsinfo); 
position := fslnfo.fMark 
collection.size := fslnfo.size 
END; 


atEnd := position = collection.size 
LatestError(newErr, error); {$H+} 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S sResDat} 
PROCEDURE TFileScanner. XferSequential(whichWay: xReadWrite; pFirst: Ptr; numBytes: LONGI NT) 
BEGIN 
{$I FC fTrace}BP(1); {$ENDC} 
SELF. XferRandom( whichWay, pFirst, numBytes, fSequential, 0); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$S slnit1} 
D; 


{$$ SgCLAres} 


{$1FC compatibleLists} {Backward Compatibility} 
METHODS OF TDynami cArray; 
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FUNCTION TDynamicArray.CREATE(object: TObject; heap: THeap; bytesPerRecord: INTEGER 
initial Size: INTEGER): TDynamicArray; 
BEGIN 
{$I1FC fTrace}BP(1); {$ENDC} 
IF ODD( bytesPerRecord) THEN 
bytesPerRecord := bytesPerRecord + 1; 
SELF := POINTER(ORD(TArray. CREATE(object, heap, initialSize, bytesPerRecord))); {NB reversed args} 
Handl e( SELF) ** := ORD(THISCLASS); 
SELF. EditAt(1, initial Size); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TDynamicArray. BeSize(newSize: INTEGER); 
BEGIN 

SELF. EditAt(SELF.size + 1, newSize - SELF.size); 
END; 


FUNCTION TDynamicArray.Class: TClass; {So New- & Resize- DynObject will use correct object size} 
BEGIN 

Class := cArray; 
END; 


FUNCTION TDynamicArray.numRecords: INTEGER 
BEGIN 

numRecords := SELF.size; 
END; 


{$S slniti} 
END; 
{$$ SgCLAres} 


METHODS OF Ti ndexList; 


FUNCTION TindexList.CREATE(object: TObject; heap: THeap; initialSize: INTEGER): TlndexList; 
BEGIN 

{$I1FC fTrace}BP(1); {$ENDC} 

SELF := POINTER(ORD(TList.CREATE(object, heap, initialSize))); 

Handl e( SELF) ** := ORD(THISCLASS); 

SELF. EditAt(1, initial Size); 

{$I1FC fTrace}EP; {$ENDC} 
END; 
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FUNCTION TindexList.Class: TClass; {So New- & Resize- DynObject will use correct object size} 


BEGIN 
Class := cLlist; 
END; 


FUNCTION TindexList. numEl ements: INTEGER 
BEGIN 

numEl ements := SELF.size 
END; 


sl nit1} 


SgCLAres} 


METHODS OF TLinkList; 


{$$ 
END; 


{$8 


FUNCTION TLinkList.CREATE(object: TObject; heap: THeap): TLinkList; 
BEGIN 

{$I FC fTrace}BP(1); {$ENDC} 

SELF := POINTER(ORD(TList.CREATE( object, heap, 0))); 
Handl e( SELF) ** := ORD( THI SCLASS); 

{$IFC fTrace}EP; {$ENDC} 
END; 


FUNCTION TLinkList. numEl ements: INTEGER 
BEGIN 

numEl ements := SELF.size 
END; 


sl nitl} 


SgCLAres} 


METHODS OF TBlockList; 


FUNCTION TBlockList. CREATE(object: TObject; heap: THeap; itsMi nBl ockSize: 


BEGIN 
{$I FC fTrace}BP(1); {$ENDC} 
SELF := POINTER(ORD(TList.CREATE( object, heap, 0))); 
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002924 Handl e( SELF) ** := ORD(THISCLASS); 
002925 {$I1FC fTrace}EP; {$ENDC} 

002926 END; 

002927 

002928 

002929 FUNCTION TBlockList. numEl ements: INTEGER 
002930 BEGIN 

002931 numEl ements := SELF.size 

002932 END; 

002933 

002934 

002935 {$$ slnit1} 

002936 END; 

002937 {$8 SgCLAres} 

002938 

002939 

002940 METHODS OF TFileStream 

002941 

002942 

002943 FUNCTION TFileStream. CREATE(object: TObject; heap: THeap; path: $255; manip: TAccesses): TFileStream 
002944 BEGIN 

002945 {$IFC fTrace}BP(1); {$ENDC} 
002946 IF object = NIL THEN 

002947 object := NewObject(heap, THISCLASS) 
002948 SELF := TFileStream(TFileScanner. CREATE( object, TFile.CREATE(NIL, heap, path, ''), manip)); 
002949 {$I1FC fTrace}EP; {$ENDC} 

002950 END; 

002951 

002952 

002953 FUNCTION TFileStream Size: LONGI NT; 
002954 BEGIN 

002955 {$I1FC fTrace}BP(1); {$ENDC} 
002956 Size := SELF.collection.size 
002957 {$I1FC fTrace}EP; {$ENDC} 

002958 END; 

002959 

002960 

002961 {$$ slnit1} 

002962 END; 

002963 {$8 SgCLAres} 

002964 

002965 


002966 {$8 SgCLAcI d} 
002967 PROCEDURE FileDelete(path: $255); 


002968 VAR osPath: Pat hname: 

002969 error: INTEGER; 

002970 BEGIN 

002971 osPath := path; { THIS |S THE SECOND TIME WE COPY THE STRING !!!! } 
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Kill_Object(error, osPath); 
END; 
{$$ SgCLAres} 


{$8 SgCLAcl d} 
PROCEDURE FileLookup(VAR error: INTEGER; path: $255); 


VAR refinfo: FS Info 
osPath: Pat hname: 
BEGIN 
osPath := path; { THIS |S THE SECOND TIME WE COPY THE STRING !!!! } 
Lookup(error, osPath, reflnfo); 


END; 
{$$ SgCLAres} 


{$$ SgCLAcl d} 
PROCEDURE FileRename(oldPath, newPath: $255); 


VAR osPath: Pat hname 
osEname: E_ Name; 
error: INTEGER; 
centerHyphen: INTEGER 

BEGIN 


osPath := oldPath; 
centerHyphen := pos('-{', newPath); 
osEname := copy(newPath, centerHyphentl, l|ength(newPath)-centerHyphen) 
Rename Entry(error, osPath, osEname); 
END; 
{$$ SgCLAres} 


{$$ SgCLAcl d} 
FUNCTION FileModified(path: $255): LONGI NT; 


VAR refinfo: FS Info 
osPath: Pat hname: 
error: INTEGER; 
BEGIN 
osPath := path; { THIS |S THE SECOND TIME WE COPY THE STRING !!!! } 


Lookup(error, osPath, reflnfo); 
IF error <= 0 THEN 
FileModified := reflnfo.DTM 
ELSE 
FileModified := -1; 
END; 
{$$ SgCLAres} 


{$ENDC} {Backward Compatibility} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 681 of 


1012 


Apple Lisa Computer Technical Information 


003020 
003021 
003022 
003023 


End of File -- Lines: 3023 Characters: 79889 


Apple Lisa ToolKit 3.0 Source Code Listing -- 682 of 1012 


000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


Apple Lisa Computer Technical Information 


{INCLUDE FILE UOB)ECT4 -- KI TBUG} 
{Copyright 1983, 1984, Apple Computer, Inc. } 


{changed 04/30 1412 In GetDollarD make sure the constants we are searching for don't appear in the 
body of the procedure} 

{ EPSSrnsssssssssessssssssessssesseseses VALIDITY CHECKS sszsasezaastsasstasssnasssSessssesscca } 

{$5 SgCLAcI d} 


FUNCTION ValidGlobal Address(addr: LONGINT): BOOLEAN: 


BEGIN 
{$1FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
ValidGlobal Address := (% GetA5 > addr) AND (addr > ORD( @addr)) 
END; 


FUNCTION ValidSTP(stAddr: LONGI NT): BOOLEAN 
VAR count: INTEGER 
hi Word: INTEGER 
BEGIN 
{$IFC fMaxTrace}BP(1); {$ENDC} 
{$1FC fMaxTrace}EP; {$ENDC} 
IF ValidGlobal Address(stAddr) AND ValidGlobalAddress(stAddr+3) AND NOT ODD(stAddr) THEN 


BEGIN 
count := 100; {Prevent infinite | oops} 
hiWord := 0 


WHILE ValidGl obal Address(stAddr-4) AND ValidGlobal Address(stAddr-1) AND NOT ODD(stAddr) AND 
(count > 0) DO 


BEGIN 
{$R-} hi Word := TpI NTEGER(stAddr- 4) *; 
stAddr := TpLONGINT(stAddr-4)%*; {$IFC fRngObj ect }{$R+}{$ENDC} 
count := count - 1; 
END; 
ValidSTP := hiWord = -1; 


END 
ELSE 
ValidSTP := FALSE: 
END; 
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{Not NIL; and we have made a heap 
{Handle reasonabl e} 

{Master ptr reasonable} 
{Reasonable stp} 

{Go for it} 


FUNCTION ValidObject(hndl: Handle): BOOLEAN 
BEGIN 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
ValidObj ect := FALSE; 
IF (hndl <> NIL) AND (cObject <> NIL) THEN 
IF ValidDataAddress(ORD(hndl)) THEN 
IF ValidDataAddress( ORD( hndl*)) THEN 
IF ValidSTP(ORD(ClassPtr(hndl))) THEN 
ValidObject := TRUE; 
END; 
{ SS SSS SS SS SSS S55 555555522222 eeeeee=e==°= 


{$$ SgCLAcl d} 


PROCEDURE MarkHeap{(heap: THeap 


aA s aman 


Poon aon Laon aoe 


mpAddress: 


LONGI NT) }; 


MarkHeap accepts two parameters: (1) a pointer (heap) to the document heap and (2) the address, } 
(mpAddress) of a "root" master pointer from which all other accessible objects on heap can be reached. 


MarkHeap marks all objects that are "in-use" by marking the root object, all objects that the root object } 
has a handle on, all objects that those objects have handles on, etc. 


Marking is accomplished by setti 


the high order bit (bit 31) of the master pointer that points to the object which is to be marked. } 


Although MarkHeap operates depth-first 


without causing stack expansion, 


it is NOT recursive. Thus, it can mark long chains of objects 
lf we => x, X.f => y and y.g => z, then while y is being scanned, } 


} 


} 


ng } 


} 


x.f => wie. Thus, when y returns to x for further marking starting after f, x can know where it will } 
have to return to when its scan is complete. The comments below assume that the scan has reached y.g } 
TYPE TOffsets = RECORD 
obj ect Offset: | NTEGER; { x - mpFirst: where the object's master ptr is in the heap } 
fieldOffset: INTEGER; { @.f - @**: where the field is in the object } 
END; 
VAR hz: THz; { heap as a UnitHz type } 
mpFirst: LONGINT; { The address of the first master pointer in the heap } 
mpLast: LONGI NT; { The address of the last master pointer in the heap } 
blockPtr: TBk; { A pointer to the first (size) word of the storage block of y} 
sizelnWords: INTEGER: { The size found there } 
firstFieldAddress: LONGINT; { @y**, the address of y's first data field (usually a method-table ptr) } 
lastFieldAddress: LONGINT; { The upper limit of the fieldAddress loop--the last 4-byte field of y } 
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mpPtr: TpLONGI NT; { A handle as a pointer to a LONGINT (the master pointer) } 
mp: LONGI NT; { The master pointer value, z*, i.e., the object data address } 
fieldOffset: INTEGER; { @-g9 - @** } 
fieldAddress: LONGI NT; { The address of the field y.g, which may or may not be a handle. 

It increases by twos because a handle can start on any even address} 
previous: TOffsets; { Two offsets representing @x.f: x - mpFirst & @.f - @*%*, 


A pointer to x.f will be stashed there while z is scanned 
in the form of two offsets (see "previous") } 


hndl Address: LONGI NT; { The handle z found in or to be replaced in y.g } 


goodHandl eFound: BOOLEAN; { TRUE if a handle to an unmarked object was found in the fields of 
the present object; otherwise, FALSE. } 


{$ENDC} 


{ MarkHeap } 
{$I FC fMaxTrace}BP(1); {$ENDC} 
{$IFC fMaxTrace}EP; {$ENDC} 
hz := THz( heap); { A pointer to the heap } 
mpFirst := ORD( @hz*. argpPool ); { The address of the first master pointer } 
mpLast := mpFirst + (4 * (hz*.ipPoolMac - 1)); { The address of the last master pointer } 
fieldOffset := 0; { The offset from firstFieldAddress of the first field to 
consider } 
goodHandl eFound : = TRUE; 
previous. objectOffset := 1; { An illegal value to flag the end of the entire marking operation } 
{$1FC LibraryVersion > 20} 
{Mark the hrgpnob field of the Hz} 
mpPtr := TpLONGI NT(hz*. hrgpnob); 
mpPtr* := mpPtr* + $80000000 
{Mark the hScramble field of the Hz} 
mpPtr := TpLONGI NT(hz*. hScrambl e); 
mpPtr* := mpPtr* + $80000000 
mpPtr := TpLONGI NT( mpAddress); { The handle of y } 
mpPtr* := mpPtr* + $80000000; { Mark the master pointer which points to the present object } 
REPEAT { Loop through all accessible objects} 
firstFieldAddress := mpPtr’; { The address of the first field of y } 
blockPtr := TBk(firstFieldAddress - 4); { The size word of the header of the object } 
sizelnWords := blockPtr’. hdr.cw; { The size of the object, in words } 


lastFieldAddress := firstFieldAddress + sizelnWords + sizelnWords - 6; { The last 4-byte field } 


Apple Lisa ToolKit 3.0 Source Code Listing -- 685 of 1012 


Apple Lisa Computer Technical Information 


000140 

000141 fieldAddress := firstFieldAddress + fieldOffset:; { Where to start or resume the scan of y } 
000142 

000143 1F (NOT goodHandl eFound) THEN 

000144 BEGIN { We have just returned to y after scanning z } 

000145 previous := TOffsets(TpLONGINT(fieldAddress)%*);{ Restore previous offsets fromfield y.g } 
000146 TpLONGINT(fieldAddress)* := hndl Address; { Restore the original contents of y.g, which 
000147 was z } 

000148 

000149 fieldAddress := fieldAddress + 2: { Advance to the next potential handle } 

000150 fieldOffset := fieldOffset + 2; 

000151 END; 

000152 

000153 goodHandl eFound : = FALSE; { No handle to an unmarked object has been found yet } 

000154 

000155 { Scan the fields of the present object in search of a handle to an unmarked object } 

000156 WHILE ((fieldAddress <= lastFieldAddress) AND (NOT goodHandleFound)) DO 

000157 BEGIN 

000158 hndl Address := TpLONGINT(fieldAddress) *; { Get what may be the address of a master pointer } 
000159 

000160 IF (hndl Address >= mpFirst) THEN 

000161 IF (hndl Address <= mpLast) THEN 

000162 IF (LintAndLIint(hndl Address - mpFirst, 3) = 0) THEN 

000163 BEGIN 

000164 { if the address of the alleged master pointer lies between the } 
000165 { addresses of the first and last master pointers, inclusive, and if } 
000166 { the address of the alleged master pointer lies a multiple of 4 bytes } 
000167 { (the length of a master pointer) fromthe address of the first } 
000168 { master pointer, then the given address is the address of a master } 
000169 { pointer (i.e. it is a valid handle). } 

000170 mpPtr := TpLONGINT(hndl Address); { Get a handle on the validated master pointer } 
000171 mp := ORD( mpPtr *) 

000172 1F (mp >= 0) THEN { unmarked } 

000173 1F NOT (((mp >= mpFirst) AND (mp <= mpLast)) OR (mp = 1)) THEN 

000174 BEGIN { not on the free list; it must be in the heap proper } 

000175 goodHandl eFound : = TRUE; { A handle to an unmarked object has been found } 
000176 

000177 TOF fsets(TpLONGINT(fieldAddress)*) := previous; { Save offsets in the 
000178 field y.g } 

000179 

000180 previous.fieldOffset := fieldOffset; { y's current offsets are z's 

000181 previous ones } 

000182 previous. objectOffset := mpAddress - mpFirst; 

000183 

000184 mpAddress := hndl Address; { The handle of z } 

000185 END; 

000186 END; 

000187 
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000188 
000189 
000190 
000191 
000192 
000193 
000194 
000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
000210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
000228 
000229 
000230 
000231 
000232 
000233 
000234 
000235 


Apple Lisa Computer Technical Information 


fieldAddress := fieldAddress + 2; { Advance to the next potential handle } 


fieldOffset := fieldOffset + 2; { Set offset to next potential handle } 
END; 

1F goodHandl eFound THEN { y.g contained the handle of z } 
BEGIN 
mpPtr* := mpPtr* + $80000000; { Mark the master pointer of z } 
fieldOffset := 0; { Prepare to scan z } 
END 

ELSE 
BEGIN { Finished examining the fields of y. Prepare to return to x.f } 
hndl Address := mpAddress; { The handle y will be put back into x.f where it belongs } 
fieldOffset := previous. fieldOffset; { Restore fieldOffset to @.f - @** } 
mpAddress := mpFirst + previous. obj ect Offset; { Restore mpAddress to x } 
mpPtr := TpLONGINT( mpAddress); { The handle of y } 
END; 

UNTIL previous. objectOffset = 1; { until all the fields of the original object have been examined } 


{ MarkHeap } 


PROCEDURE SweepHeap{(heap: THeap; report: BOOLEAN) }; 


{ This procedure sweeps through all existing objects on the document heap specified by the handle heap. } 
{ If the parameter report has the value TRUE, then the classes of all unmarked objects are displayed on the } 
{ alternate screen; otherwise, if report is FALSE, the unmarked objects are quietly freed-up. } 


VAR tempPtr: TpLONGINT; { a temporary pointer used either to carry out simple indirection or to mark a } 
{ master pointer } 


PROCEDURE CollectGarbage (obj: TObject); 


{ This procedure accepts a handle, obj, to an object and frees or reports that object (depending on the } 
{ value of SweepHeap's parameter, report) if its master pointer is not marked. If, the } 
{ object's master pointer is marked, then this procedure unmarks the object's master pointer but } 
{ otherwise leaves the object alone. } 
VAR mpAddress: LONGI NT; { the address of the master pointer specified by the handle obj } 
cl sName: TClassName; { the name of that class } 
hex Ord: $8; { the handle of the object, as a hex string } 


BEGI N { CollectGarbage } 
mpAddress := ORD( obj); 
tempPtr := TpLONGI NT( obj); { get a handle of the right type on the given object OB) } 


IF (tempPtr* < 0) THEN 
BEGIN { if the given object OB) is marked } 
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000236 tempPtr := TpLONGI NT( mpAddress); { Unmark the master pointer that points to the present object } 
000237 tempPtr* := tempPtr* - $80000000; { Note: 2*31 = $80000000 } 

000238 END 

000239 ELSE |F report THEN 

000240 BEGIN 

000241 WriteLn; 

000242 IF ValidObj ect(Handle(obj)) THEN 

000243 CpToCn(TPSliceTable(ClassPtr(Handle(obj))), TS8(clsName) ) 

000244 ELSE 

000245 clsName := '22772722?': 

000246 

000247 LI ntToHex(ORD(obj), @hexOrd); 

000248 Write (CHR(7), ‘Found garbage object $', hexOrd, ' of class ', clsName); { Report the garbage } 
000249 END 

000250 ELSE 

000251 FreeH(THz(heap), TH(obj)); { It is unmarked, i.e., garbage. Free it. } 
000252 

000253 END; { CollectGarbage } 

000254 

000255 BEGIN { SweepHeap } 

000256 {$IFC fMaxTrace}BP(1); {$ENDC} 

000257 {$IFC fMaxTrace}EP; {$ENDC} 

000258 EachObject(heap, Coll ectGarbage) 

000259 END; { SweepHeap } 

000260 

000261 

000262 { ssssssssssssssssssssssessssssssscsss== ABCBREAK ============sssssssssssscsssscssssssss= } 
000263 

000264 


000265 {$IFC fDbgObj ect} 

000266 PROCEDURE Tall yZero; FORWARD; 

000267 {$ENDC} 

000268 

000269 

000270 {$$ sError} 

000271 PROCEDURE ABCBreak{(s: $255; errCode: LONGI NT) }; 


000272 VAR asHex: $8 

000273 BEGIN 

000274 {$1 FC fDbgObj ect} 

000275 WiteLn; 

000276 Write(CHR(7), s); {Beep} 

000277 IF errCode <> 0 THEN 

000278 BEGIN 

000279 Li nt ToHex(errCode, @asHex); 

000280 Write(': ', errCode:1, ' = $', asHex) 
000281 END; 

000282 WriteLn; 

000283 {Turn off all tracing, tallying, etc. } 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
000295 
000296 
000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 
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tall yingCalls := FALSE; 

Tall yZero; 

fTraceEnabled := FALSE: 

defTraceCount := 0; 

traceCount := defTraceCount; 

returnToMain := TRUE; 

EntDebugger(' ', ‘Error caused ABCBreak call') 

{$ELSEC} 

HALT; 

{$ENDC} 
END; 
{$$ SgCLAcl d} 
{ SSS SSsssSssSssssssssSssssssssssssS= = $D DECODING sasssssenssssssscsssssssssssssssssssccs } 
{$1FC fTrace OR f DebugMet hods} 
{$$ SgCLAdbg} 
FUNCTION Get DollarD(pFrame: Tppl NTEGER 

VAR nameOf Class: TClassName; VAR nameOf Method: $8: VAR nextPC: LONGI NT): BOOLEAN 


LABEL 1: 

VAR pname: TPByte; 
pPC: Tppl NTEGER; 
pe: Tpl NTEGER; 
start Of Segment: TpLONGI NT; 
endOf Segment: TpI NTEGER 
pel: TpLONGI NT; 


fBothClassAndProc: BOOLEAN 


PROCEDURE SwapIn(valueString: S8) 
BEGIN 
END; 


PROCEDURE CopyName( VAR anyName: S8) 
VAR j: INTEGER; 


BEGIN 
anyName := '12345678' 
FOR j := 1 TO 8 DO 
BEGIN 
anyName[j] := CHR( Wand(pname*, 127)); 
pname := TPByte(ORD( pname) +1); 
END; 
END; 
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000332 
000333 
000334 
000335 
000336 
000337 
000338 
000339 
000340 
000341 
000342 
000343 
000344 
000345 
000346 
000347 
000348 
000349 
000350 
000351 
000352 
000353 
000354 
000355 
000356 
000357 
000358 
000359 
000360 
000361 
000362 
000363 
000364 
000365 
000366 
000367 
000368 
000369 
000370 
000371 
000372 
000373 
000374 
000375 
000376 
000377 
000378 
000379 
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Information 


PROCEDURE AdvancePC 


BEGIN 
IF ORD( pc) >= ORD( endOfSegment) THEN 
GOTO 1; 
pe := Tplnteger(ORD( pc) +2); 
END; 


{$1FC fMaxTrace}BP(1); {$ENDC} 

{$1FC fMaxTrace}EP; {$ENDC} 

pPC := TppINTEGER(ORD( pFrame) + 4); 

pe := pPC’; 

nameOfClass :='': 

nameOf Method := '': 

nextPC := 0; 

Get DollarD := FALSE; 

1F ORD(pc) <> 0 THEN 
BEGIN 

{$R-} Swapln(TPS8(pc) *); 


start Of Segment 
endOf Segment 


TpLONGI NT(LI nt AndLi nt( LONGI NT( PC), 


{$I1FC fRngObj ect} {$R+} {$ENDC} {Be sure the code is swapped in} 


= $FFFE0000)); 
+= TpINTEGER(LONGINT(startOfSegment) + LintAndLint(startOfSegment*, SOOFFFFFF) {length} ) 


{We add the -1 to the following tests so that the things we are searching for don't 


appear in the body of the procedure. } 
WHILE (pc*-1) <> ($4E5E-1) DO 
IF ORD( pc) >= ORD(endOf Segment) THEN 
GOTO 1 
ELSE 
pc := Tpl NTEGER( ORD( pc) +2); 
WHILE ((pc*-1) <> ($4E75-1)) AND 
((pce*-1) <> ($4ED0-1)) DO 
1F ORD( pc) >= ORD( endOf Segment) THEN 
GOTO 1 
ELSE 
pc := Tpl NTEGER( ORD( pc) +2); 


next PC := ORD(pc); 
GetDollarD := TRUE; 


pname := TPByte( ORD( pc) +3); 
fBothCl assAndProc := pname* < 0; 
pname := TPByte( ORD( pname)-1); 
CopyName( nameOf Met hod); 

IF fBothClassAndProc THEN 
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000380 CopyName( S8(nameOf Cl ass) ) 

000381 ELSE 

000382 nameOfClass := '' 

000383 END; 

000384 1: 

000385 END; 

000386 {$ENDC} 

000387 

000388 

000389 { =sssssssssssssssssssssssssssssssses= CALL TALLY ========s=s===ssssssssssssessssssssscc= } 
000390 

000391 

000392 {$l FC fTrace} 

000393 

000394 

000395 {$8 SgCLAi ni } { *** NB *** [s this Sg necessary? } 
000396 

000397 

000398 PROCEDURE Tall yStart; 

000399 VAR ti meNow: LONGI NT; 

000400 i: I NTEGER; 

000401 arrSize: INTEGER; 

000402 elapsed: LONGI NT; (***) 

000403 BEGIN 

000404 IF tallies = NIL THEN 

000405 BEGIN 

000406 {array size must be <= maxTallies; imposed by declaration of tallies global variable. } 
000407 arrSize := Min(numMethods, maxTallies); 

000408 tallies := THTallies(TArray. CREATE(NIL, mainHeap, arrSize, SIZEOF(TTally))); 
000409 TArray(tallies).InsNullsAt(1, arrSize); 

000410 elapsed := 0;(***) 

000411 END 

000412 ELSE {conti nui ng} 

000413 elapsed := stopTime - startTi me; (***) 

000414 

000415 timeNow := MicroTimer 

000416 startTime := timeNow - elapsed; (***) 

000417 FOR i := 0 TO tabLevel DO {BP's already passed} 
000418 traceTimes[i] := timeNow; (***) 

000419 stopTime := timeNow 

000420 

000421 tall yingCalls := TRUE; 

000422 END; 

000423 

000424 

000425 PROCEDURE Tall yZero 

000426 BEGIN 

000427 IF tallies <> NIL THEN 
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000428 BEGIN 

000429 Free(TArray(tallies)) 

000430 tallies := NIL; 

000431 END; 

000432 END; 

000433 

000434 

000435 FUNCTION TallySlot(pc: LONGINT): INTEGER; 

000436 

000437 FUNCTION ComparePC(hashindex: INTEGER): THashCompare 
000438 VAR myPC: LONGI NT; 

000439 BEGIN 

000440 myPC := tallies**.recs[hashl ndex].epPC 
000441 IF myPC = 0 THEN 

000442 ComparePC := cHole 

000443 ELSE 

000444 IF myPC = pc THEN 

000445 ComparePC := cMatch 

000446 ELSE 

000447 ComparePC := cMismatch; 

000448 END; 

000449 

000450 BEGIN 

000451 TallySlot := LookuplnHashArray(tallies**.header.size, pc, FALSE, ComparePC) 
000452 END; 

000453 

000454 

000455 PROCEDURE Tally(pc, micSecs: LONGI NT) 

000456 VAR slot: INTEGER 

000457 segNum: INTEGER; 

000458 pPC: TpByte; 

000459 BEGIN 

000460 pPC := TPByte( @pc); 

000461 pPC* := 0; {occasionally, a return addr hibyte is nonzero! no one knows why... } 
000462 

000463 slot := Tall ySlot(pc) 

000464 WTH tallies**.recs[ABS(slot)] DO 

000465 IF slot > 0 THEN 

000466 BEGIN 

000467 count := count + 1; 

000468 microseconds := microseconds + micsecs 
000469 END 

000470 ELSE 

000471 IF slot < 0 THEN 

000472 BEGIN 

000473 segNum := TpI NTEGER(pPC)* DIV 2; 
000474 1F segNum = 0 THEN 

000475 ABCBreak('I mpossible Tally PC', pc) 
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000476 
000477 
000478 
000479 
000480 
000481 
000482 
000483 
000484 
000485 
000486 
000487 
000488 
000489 
000490 
000491 
000492 
000493 
000494 
000495 
000496 
000497 
000498 
000499 
000500 
000501 
000502 
000503 
000504 
000505 
000506 
000507 
000508 
000509 
000510 
000511 
000512 
000513 
000514 
000515 
000516 
000517 
000518 
000519 
000520 
000521 
000522 
000523 


ELSE 


END 
ELSE 
BEGI 
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BEGIN 

epPC := pc; 

count:= 1; 

microseconds := micSecs; 
END; 

N 


ABCBreak('Tally table full--more non- method procedures had EP''s than expected’, 


tall 
END; 
END; 


tallies**. header. size); 
yingCalls := FALSE; 


PROCEDURE Tall yReport; 


VAR totalCalls: LONGI NT; 
total Ti me: LONGI NT; 
callees: | NTEGER; 
slot: INTEGER; 
calls: INTEGER; 
micSecs: LONGI NT; 
roundoff: LONGI NT; 

i: | NTEGER; 

j: INTEGER; 
sortKeys: THI dxArray; 
segCount: ARRAY [0..127] OF LONGI NT; 
segTi me: ARRAY [0..127] OF LONGI NT; 
pc: LONGI NT; 
sortBy: INTEGER; 
Swapem: BOOLEAN; 

sl oti: INTEGER; 

sl otj: INTEGER; 
pcetg: | NTEGER; 
elapsed: LONGI NT; 
segName: $8; 

segNum: INTEGER; 
cState: TConvResult; 
want Called: BOOLEAN; 

cl sName: TCl assName: 
mt hName: $8; 

next PC: LONGI NT; 
inStr: $255; 

hexPC: $8; 


PROCEDURE ReadSegNames; 
CONST 
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000524 bSegTable = $9A; 

000525 bEOFMark = $00 

000526 bModuleName = $80 

000527 bCodeBlock = $85; 

000528 

000529 modNameSkip = 8; {# bytes to skip in module name block, to get segment name} 
000530 

000531 all Blanks = ' ': {8 blanks} 

000532 blankSeg = ' BLANKSEG' 

000533 

000534 TYPE 

000535 SegTbl Entry = RECORD 

000536 SegName: PACKED ARRAY[1..8] OF CHAR 
000537 SegNumber: | NTEGER; 

000538 Versionl: LONGI NT; 

000539 Version2: LONGI NT; 

000540 END; 

000541 

000542 VAR presi nfo: Procl nf oRec 

000543 error: INTEGER; 

000544 aFile: TFile; 

000545 scanner: TFil eScanner 

000546 bl kType: LONGI NT; 

000547 bl kSize: LONGI NT; 

000548 nSegments: LONGI NT; 

000549 segbl k: SegTbl Entry; 

000550 addr: LONGI NT; 

000551 i: INTEGER; 

000552 

000553 BEGIN 

000554 Info Process(error, My_id, presInfo) 

000555 IF error <= 0 THEN 

000556 BEGIN 

000557 segName := all Blanks 

000558 segNames := TArray.CREATE(NIL, mainHeap, 127, SIZEOF(S8)) 
000559 segNames. I nsNullsAt(1, 127) 

000560 

000561 aFile := TFile.CREATE(NIL, mainHeap, prcsinfo.progPathName, '') 
000562 scanner := TFileScanner.CREATE(NIL, aFile, [fRead]); 
000563 WriteLn('Reading segment numbers and names from', prcsinfo. progPat hName) 
000564 WriteLn; 

000565 

000566 REPEAT 

000567 bl kType := scanner. ReadNumber(1); 

000568 bl kSize := scanner. ReadNumber(3) - 4; 

000569 

000570 CASE bl kType OF 

000571 bSegTable: 
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000572 
000573 
000574 
000575 
000576 
000577 
000578 
000579 
000580 
000581 
000582 
000583 
000584 
000585 
000586 
000587 
000588 
000589 
000590 
000591 
000592 
000593 
000594 
000595 
000596 
000597 
000598 
000599 
000600 
000601 
000602 
000603 
000604 
000605 
000606 
000607 
000608 
000609 
000610 
000611 
000612 
000613 
000614 
000615 
000616 
000617 
000618 
000619 
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BEGIN 

nSegments := scanner. ReadNumber (2); 

bl kSize := bl kSize-2: 

FOR i := 1 TO nSegments DO 
BEGIN 
scanner. XferSequential(xRead, @segblk, SIZEOF(SegTbl Entry) ); 
bl kSize := bl kSize - scanner. actual 
XferLeft(Ptr(@segblk.segName), Ptr(ORD( @segName) +1), 8); 
segNames,. PutAt(segbl k.SegNumber, @segName) ; 
END; 

END; 


bModul eName: 


BEGIN 
scanner. Ski p( modNameSki p) 
bl kSize := bl kSize- modNameSki p; 


scanner. XferSequential(xRead, Ptr(ORD( @segName) +1), 8); 
bl kSize := bl kSize - scanner.actual 
1F segName = all Blanks THEN 
segName := bl ankSeg; 
END; 


bCodeBl ock: 


END; 


scanner, 


BEGIN 

addr := scanner. ReadNumber( 4); 

bl kSize := bl kSize - 4; 

segNames. PutAt(addr DIV $20000, @segName); 
END; 


Ski p( bl kSize); 


UNTIL scanner. atEnd OR (bl kType = bEOFMark); 


scanner. Close; 


END; 
END; 


( FARK HH KK KH 


PROCEDURE ReadSegNames; 


LABEL 
1; 


VAR prcsIinfo: 
error: 
progVol ume: 
fileName: 
progExt: 


Apple Li 


Proci nf oRec; 
INTEGER; 
TFilePath; 
TFilePath; 
TFilePath; 
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000620 
000621 
000622 
000623 
000624 
000625 
000626 
000627 
000628 
000629 
000630 
000631 
000632 
000633 
000634 
000635 
000636 
000637 
000638 
000639 
000640 
000641 
000642 
000643 
000644 
000645 
000646 
000647 
000648 
000649 
000650 
000651 
000652 
000653 
000654 
000655 
000656 
000657 
000658 
000659 
000660 
000661 
000662 
000663 
000664 
000665 
000666 
000667 


1: 


BEGIN 
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segNameFile: TEXT; 

i | NTEGER; 
segName: $8; 
segNum: INTEGER; 


Info Process(error, My_id, presInfo) 
IF error <= 0 THEN 


BEGIN 
i := Length(prcsi nfo. progPat hName) ; 
WHILE i > 0 DO 


IF (presinfo. progPathName[i] = '}') OR (presinfo.progPathName[i] = '.') THEN 
GOTO 1 
ELSE 
i:ei- 1; 
1F i > 0 THEN 


filename := Concat(Copy(prcsinfo. progPathName, 1, i), 'SegNames. Text'); 
Reset (segNameFile, fileName); 


i := loResult; 
1F i > 0 THEN 

WriteLn('Unable to open ', fileName, ' because of error number ', i: 1) 
ELSE 

BEGIN 

WriteLn('Reading segment numbers and names from', fileName) 

WriteLn; 


segNames := TArray.CREATE(NIL, mainHeap, 127, SI ZEOF(S$8)) 
segNames. I nsNullsAt(1, 127); 


WHILE (i = 0) AND NOT Eof(segNameFile) DO 


BEGIN 
segNum := 0; 
ReadLn(segNameFile, segNum, inStr); 
i := loResult; 
1F (i <= 0) AND (1 <= segNum) AND (segNum <= 127) THEN 
BEGIN 
Tri mBl anks(@inStr); 
segName := Copy(Concat(inStr, ' '), 1, 8); 
segNames. PutAt(segNum, @segName); 
END 
ELSE 
IF i > 0 THEN 
WriteLn('*** loError number ', i:1, ' reading ', fileName) 
ELSE 
1F NOT Eof(segNameFile) THEN 
WriteLn('*** Bad segment number: ', segNum:1, ' in file ', fileName); 
END; 
segName := '22222222'; 
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000671 
000672 
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000676 
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000678 
000679 
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000683 
000684 
000685 
000686 
000687 
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000689 
000690 
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000692 
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000694 
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000696 
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000702 
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000704 
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000708 
000709 
000710 
000711 
000712 
000713 
000714 
000715 
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FOR segNum:= 1 TO 127 DO 
|F TPByte(segNames. At(segNum))* = 0 THEN 
segNames. PutAt(segNum, @segName) ; 
END; 


WriteLn; 

WriteLn; 

Cl ose(segNameFile); 
END; 


END; 
KEKKKEEEEE) 


PROCEDURE WriteName 


BEGIN 
1F mthName = '' THEN 
BEGIN 
LI ntToHex(pc, @hexPC); 
Write('$', hexPC, ' hi )er 
END 
ELSE 
1F clsName = '' THEN 
Write(mthName, ' ') 
ELSE 
Write(clsName, '.', mthName) 
END; 


FUNCTION Tall yRange(pcl, pc2: LONGINT): INTEGER 
VAR slot: INTEGER; 
BEGIN {If this proves too slow, make the sortarray by PC and binary search it} 
FOR slot := 1 TO tallies**. header.size DO 
WITH tallies**.recs[slot] DO 
IF count > 0 THEN 
IF pcl < epPC THEN 
IF epPC <= pc2 THEN 
BEGIN 
Tall yRange := slot; 
EXIT( Tall yRange); 
END; 
TallyRange := 0 
END; 


PROCEDURE SwapIn(valueString: $8) 
BEGIN 
END; 


BEGIN 
FOR j := tabLevel - 1 DOWNTO 0 DO (***) 
BEGIN 
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000716 elapsed := stopTime - traceTi mes[j]; 

000717 FOR i := j - 1 DOWNTO 0 DO (*%*) 

000718 traceTimes[i] := traceTimes[i] + elapsed; 

000719 Tall y( TpLONGI NT(traceFrames[j] + 4)*, elapsed); 
000720 END; 

000721 

000722 total Time := stopTime - startTime(* - debugTi me*); 
000723 WiteLn; 

000724 WriteLn((total Time + 500) DIV 1000:1, ' milliseconds have elapsed since tallying began'); 
000725 (* WriteLn((total Time + 500) DIV 1000:1, ' milliseconds have elapsed since tallying began, not counting ', 
000726 debugTime:1, ' ms. in debug code.');*) 

000727 

000728 WriteLn; 

000729 

000730 total Calls := 0; 

000731 callees := 0; 

000732 FOR segNum:= 1 TO 127 DO 

000733 BEGIN 

000734 segCount[segNum] := 0; 

000735 segTime[segNum] := 0; 

000736 END; 

000737 

000738 FOR slot := 1 TO tallies**.header.size DO 

000739 WITH tallies**.recs[slot] DO 

000740 IF count > 0 THEN 

000741 BEGIN 

000742 total Calls := totalCalls + count; 

000743 callees := callees + 1; 

000744 segNum:= TpI NTEGER( @epPC)* DIV 2; 

000745 segCount[segNum] := segCount[segNum] + count; 
000746 segTime[segNum] := segTime[segNum] + microseconds; 
000747 END; 

000748 

000749 IF totalCalls = 0 THEN 

000750 WriteLn('All tallies are zero.') 

000751 ELSE 

000752 BEGIN {totalCalls > 0} 

000753 roundOff := total Time DIV 2; 

000754 

000755 WriteLn(callees:1, ' methods were called a total of ', totalCalls:1, ' times.'); 
000756 WriteLn; 

000757 

000758 IF segNames = NIL THEN 

000759 ReadSegNames; 

000760 

000761 WriteLn(' SEGMENT USAGE'); 

000762 WriteLn; 

000763 
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000764 WriteLn('No. of calls % of time Segment SegSize  Seg#') 

000765 WriteLn(' Wieepeveyccoceseveere Cocereteceyetwrere:' > sayeresereare-y 8 —adcetenwgsye seeel) 

000766 WriteLn; 

000767 

000768 FOR segNum:= 1 TO 127 DO 

000769 IF segCount[segNum] > 0 THEN 

000770 BEGIN 

000771 IF segNames = NIL THEN 

000772 segName := '2222222? 

000773 ELSE 

000774 segName := TPString(segNames. At(segNum) ) *; 

000775 

000776 {Be sure the code is swapped in, before getting the size of the segment} 
000777 {$R-} Swapl n(Tp$8($20000 * segNum)*); {$1 FC fRngObj ect} {$R+} {$ENDC} 
000778 

000779 WriteLn(segCount[segNum]:8, ' ...siae oF 

000780 (LONGI NT(segTi me[segNum]) * 100 + roundOff) DIV totalTime:3, '%... ', 
000781 segName, 

000782 LI nt AndLi nt (TpLONGI NT($20000 * segNum)*, $OOFFFFFF): 8, 
000783 segNum: 7); 

000784 END; 

000785 

000786 REPEAT 

000787 WriteLn; 

000788 WriteLn; 

000789 

000790 Write('Report procedure executions sorted by (C = # Calls; T = % of Time; S = Segment)? '); 
000791 ReadLn(inStr); 

000792 StrUpperCased( @inStr); 

000793 Tri mBl anks( @i nStr); 

000794 IF inStr = '' THEN 

000795 sortBy :=-1 

000796 ELSE 

000797 IF inStr[1] = 'C' THEN 

000798 sortBy := 1 

000799 ELSE 

000800 IF inStr[1] = 'T' THEN 

000801 sortBy := 2 

000802 ELSE 

000803 IF inStr[1] = 'S' THEN 

000804 sortBy := 

000805 ELSE 

000806 sortBy := 0; 

000807 

000808 IF sortBy > 0 THEN 

000809 BEGIN {sortBy > 0} 

000810 sortKeys := MakeldxArray(callees, FALSE) 

000811 
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000812 
000813 
000814 
000815 
000816 
000817 
000818 
000819 
000820 
000821 
000822 
000823 
000824 
000825 
000826 
000827 
000828 
000829 
000830 
000831 
000832 
000833 
000834 
000835 
000836 
000837 
000838 
000839 
000840 
000841 
000842 
000843 
000844 
000845 
000846 
000847 
000848 
000849 
000850 
000851 
000852 
000853 
000854 
000855 
000856 
000857 
000858 
000859 
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{$R- } 
WITH sortKeys**, tallies** DO 
BEGIN {with} 
i := 0; 
FOR slot := 1 TO header.size DO 
IF recs[slot].count > 0 THEN 


BEGIN 
i:=i +41; 
records[i] := slot; 
END; 
FOR i := 1 TO callees-1 DO 
BEGIN 
sloti := records[i]; 
FOR j := itl TO callees DO 
BEGIN 
slotj := records[j]; 
CASE sortBy OF 
1: swapem:= recs[sloti].count > recs[slotj].count 
2: swapem:= recs[sloti].microseconds > recs[slotj]. microseconds 
3: swapem:= TpINTEGER( @recs[sloti].epPC)* DIV 2 > 


TpI NTEGER( @recs[slotj].epPC)* DIV 2; 


END; 

IF swapem THEN 
BEGIN 
records[i] := slotj; 
records[j] := sloti; 
sloti := records[i]; 
slotj := records[j]; 
END; 

END; 

END; 
END: {with} 
{$1 FC fRngObj ect }{$R+}{$ENDC} 


WriteLn('No. of calls % of time Routine name 
WriteLn(' Wisterate vataMet enya esd  shatletetecepalate. “stuciecas*ee"iate; acae er wom nie haha 
WriteLn; 


FOR i := callees DOWNTO 1 DO 
BEGIN 
slot := sortKeys**.records[i]; 
WITH tallies**.recs[slot] DO 
BEGIN 
calls := count; 
micSecs := microseconds 
pe := epPC; 
E 
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000860 
000861 
000862 
000863 
000864 
000865 
000866 
000867 
000868 
000869 
000870 
000871 
000872 
000873 
000874 
000875 
000876 
000877 
000878 
000879 
000880 
000881 
000882 
000883 
000884 
000885 
000886 
000887 
000888 
000889 
000890 
000891 
000892 
000893 
000894 
000895 
000896 
000897 
000898 
000899 
000900 
000901 
000902 
000903 
000904 
000905 
000906 
000907 
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j := TpINTEGER( @pc)* DIV 2; 
IF sortBy = 3 THEN {if by segment} 
IF i < callees THEN {if not first line printed} 
IF j <> segNum THEN {if different from segment of previous line} 
WriteLn; {then leave a blank line} 
segNum := j; 


Write(calls:8, ' w.iiiae ome 


petg := (LONGINT(micSecs) * 100 + roundOff) DIV total Ti me; 
IF petg = 0 THEN 

Write(' ') 
ELSE 

Write(pcetg:3, '%); 


Write(' ... '); 


IF Get Doll arD(TppINTEGER( ORD( @pc)-4), clsName, mthName, nextPC) THEN 
Wri teName: 


LI nt ToHex(pc, @hexPC) 
Write(' ', hexPC) 


IF segNames = NIL THEN 
Wri te(segNum: 10) 
ELSE 
BEGIN 
segName := TPString(segNames. At(segNum)) *; 
IF segName = '???272?27?' THEN 
Write(segNum: 10) 
ELSE 
Write(' ', segName) 
END; 


WriteLn; 
IF CheckKeyPress('Tally and Time Listing') THEN 


ee 
END; {for i} 


TArray(sortKeys). Free 


{IF sortBy > 0} 


UNTIL sortBy < 0; 
IF segNames <> NIL THEN {segNames will be non-NIL except in case of an 10 error} 


Write('List procedures that were and weren''t called in segment [name or number]? '); 
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000908 ReadLn(inStr); 

000909 Tri mBl anks(@inStr); 

000910 StrUpperCased( @inStr); 

000911 IF inStr = '?' THEN 

000912 BEGIN 

000913 WriteLn('List of all segments used by application:') 
000914 i := 0; {# output so far} 

000915 FOR segnum:= 1 TO 127 DO 

000916 BEGIN 

000917 segname := TPString(segNames. At(segnum)) *; 
000918 I1F segname <> '' THEN 

000919 BEGIN 

000920 Write(segnum 3, ':', segname, ' '); 
000921 i := itl; 

000922 IF i MOD 5 = 0 THEN 

000923 WriteLn; 

000924 END; 

000925 END; 

000926 WriteLn; 

000927 END 

000928 ELSE 

000929 IF inStr <> '' THEN 

000930 BEGIN 

000931 StrTolnt(@inStr, segNum, cState); 

000932 IF cState <> cvValid THEN 

000933 BEGIN 

000934 segNum := 0; 

000935 FOR i := 1 TO 127 DO 

000936 BEGIN 

000937 segName := TPString(segNames. At(i))*; 
000938 StrUpperCased( @segName) 

000939 1F segName = inStr THEN 

000940 segNum := i; 

000941 END; {For i} 

000942 END {invalid number} 

000943 ELSE IF (segNum>=1) AND (segNum<=127) THEN{make sure the segment number is OK} 
000944 BEGIN 

000945 segName := TPString(segNames. At(segNum)) *; 
000946 IF segName = '' THEN 

000947 segNum:= 0; 

000948 END 

000949 ELSE 

000950 segNum := 0; 

000951 

000952 IF segNum = 0 THEN 

000953 WriteLn('No such segment' ) 

000954 ELSE 

000955 FOR wantCalled := TRUE DOWNTO FALSE DO 
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000956 
000957 
000958 
000959 
000960 
000961 
000962 
000963 
000964 
000965 
000966 
000967 
000968 
000969 
000970 
000971 
000972 
000973 
000974 
000975 
000976 
000977 
000978 
000979 
000980 
000981 
000982 
000983 
000984 
000985 
000986 
000987 
000988 
000989 
000990 
000991 
000992 
000993 
000994 
000995 
000996 
000997 
000998 
000999 
001000 
001001 
001002 
001003 
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BEGIN 
WriteLn; 
Write(' PROCEDURES THAT WERE '); 
IF wantCalled THEN 
Write(' CALLED') 
ELSE 
Write('NOT CALLED OR HAD NO BP/EP'); 
Write(' IN SEGMENT'); 


IF seghames. <> NIL THEN 


Write(': ', TPString(segNames. At(segNum) )*); 
WriteLn(' #, segNum:1, '--'); 
WriteLn; 


pe i i= seanun * $20000; 


J 
WHI LE "Bieter oCrapl regen tonblarcts 4), clsName, 


BEGIN 


IF (TallyRange(pc, nextPC) > 0) = wantCalled THEN 


BEGIN 
Wri teName 
Write(' '); 
beh #1; 
IF j = 4 THEN 
BEGIN 
j i= 0; 
WriteLn; 
END; 
END; 
pe := nextPC; 
| F CheckKeyPress( Segment Listing') THEN 


WriteLn; 
END; {FOR wantCal led} 
END; {inStr <> ''} 


UNTIL inStr = '': 


{total Calls > 0} 
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next PC) DO 


001004 
001005 
001006 
001007 
001008 
001009 
001010 
001011 
001012 
001013 
001014 
001015 
001016 
001017 
001018 
001019 
001020 
001021 
001022 
001023 
001024 
001025 
001026 
001027 
001028 
001029 
001030 
001031 
001032 
001033 
001034 
001035 
001036 
001037 
001038 
001039 
001040 
001041 
001042 
001043 
001044 
001045 
001046 
001047 
001048 
001049 
001050 
001051 
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{$$ SgCLAdbg} {for rest of file} 


{ DESSSESSsssssssssssssssssesssssssssss= "Fl ELDS" 
{$1 FC fDebugMet hods} 
PROCEDURE ParseDecl(inStr: $255; 

PROCEDURE FoundName(token: $8); 


PROCEDURE FoundType(token: 
{for arrays only:} lowerBound, 


METHODS 


$8; typeCode: TTypeCode 
upper Bound: 


numBytes: 
INTEGER; memberTypeStr: 


INTEGER; 
$255); 


PROCEDURE FoundUnexpected(token, wanted: S$8)); 


VAR p: 
token: 
eoi: 
al pha: 
start: 
inhibited: 


INTEGER; 
$8; 

| NTEGER; 
BOOLEAN; 
| NTEGER; 
BOOLEAN; 


PROCEDURE Next Token: 
BEGI N 
{Skip leading blanks} 
WHILE (p <= eoi) AND (inStr[p] <=' ') 
prepdt 


DO 


start := p; 
IF p > eoi THEN 
token := '' 
ELSE 
BEGIN 
WHILE (p <= 
rept, 
p > start; 
| pha THEN 
p+, 


p 
al pha 
1F NOT 


pwns 


p 
token : 
END; 
END; 


PROCEDURE Expect(str: 
BEGIN 
St rUpperCased( @t oken) 
IF token <> str THEN 
FoundUnexpected(token, str); 
Next Token: 


$8); 
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eoi) AND (inStr[p] IN ['-' 


Copy(inStr, start, CMin(8, p - 


» ‘0.7, 


start 


{where the last token started} 


'Z', 'a'..'z']) DO 


{A single non-al phanumeric nonblank character} 


Vi 
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{Forma word or number} 


001052 
001053 
001054 
001055 
001056 
001057 
001058 
001059 
001060 
001061 
001062 
001063 
001064 
001065 
001066 
001067 
001068 
001069 
001070 
001071 
001072 
001073 
001074 
001075 
001076 
001077 
001078 
001079 
001080 
001081 
001082 
001083 
001084 
001085 
001086 
001087 
001088 
001089 
001090 
001091 
001092 
001093 
001094 
001095 
001096 
001097 
001098 
001099 
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END; 


FUNCTION ParseNumber: LONGI NT; 
VAR k: LONGI NT; 
cState: TConvResult; 
BEGIN 
StrToLint(@token, k, cState); 
IF cState = cvValid THEN 


ParseNumber := k 
ELSE 

FoundUnexpected(token, ‘a number'); 
Next Token: 


END; 
PROCEDURE ParseField; FORWARD; 
PROCEDURE ParseType(inhibit: BOOLEAN); 


VAR typeName: $8; 
upName: $8; 
al phaName: BOOLEAN; 
word: $8; 
| ower Bound: INTEGER; 
upper Bound: I NTEGER; 
pp: I NTEGER; 
i: | NTEGER; 
len: INTEGER; 
wasI nhi bited: BOOLEAN; 

BEGIN 
wasInhibited := inhibited; 


IF inhibit THEN 
inhibited := TRUE; 
typeName := token; 
upName := token; 
StrUpperCased( @upName) ; 
al phaName := al pha; 
Next Token: 
1F NOT al phaName THEN 
FoundUnexpected(typeName, ‘typename’ ) 
ELSE 
IF upName = 'RECORD' THEN 
BEGIN 
REPEAT 
ParseField: 
word := token; 
StrUpperCased( @word); 
UNTIL (word = 'END') OR (word =''); 
Expect('END'); 
END 


Apple Lisa ToolKit 3.0 Source Code Listing -- 705 


of 1012 


001100 
001101 
001102 
001103 
001104 
001105 
001106 
001107 
001108 
001109 
001110 
001111 
001112 
001113 
001114 
001115 
001116 
001117 
001118 
001119 
001120 
001121 
001122 
001123 
001124 
001125 
001126 
001127 
001128 
001129 
001130 
001131 
001132 
001133 
001134 
001135 
001136 
001137 
001138 
001139 
001140 
001141 
001142 
001143 
001144 
001145 
001146 
001147 


Apple Lisa Computer Technical 


Information 


ELSE 

|F upName = 'ARRAY' THEN 
BEGIN 
Expect('['); 


lowerBound := ParseNumber 


Expect('. 


‘yi 
Expect('.'); 


upperBound := ParseNumber 


Expect(']'); 

Pp == P; 

Expect('OF'); 
ParseType( TRUE) ; 

1F NOT inhibited THEN 


FoundType('ARRAY', yArray, 0, lowerBound, upperBound, Copy(inStr, pp, start - pp)); 


END 

ELSE 

1F upName = 'STRING' THEN 
BEGIN 
Expect('['); 
len := ParseNumber 
Expect(']'); 
1F NOT inhibited THEN 

FoundType('STRING', 


ELSE 
1F upName = 'BOOLEAN' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 
END 
ELSE 
|F upName = 'CHAR' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 


ELSE 
|F upName = 'BYTE' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 
END 
ELSE 
1F upName = 'HEXBYTE' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 


yString, len 


yBoolean, 1, 


yChar, 2, 0, 


yByte, 1, 0, 


yHexByte, 1, 
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001148 
001149 
001150 
001151 
001152 
001153 
001154 
001155 
001156 
001157 
001158 
001159 
001160 
001161 
001162 
001163 
001164 
001165 
001166 
001167 
001168 
001169 
001170 
001171 
001172 
001173 
001174 
001175 
001176 
001177 
001178 
001179 
001180 
001181 
001182 
001183 
001184 
001185 
001186 
001187 
001188 
001189 
001190 
001191 
001192 
001193 
001194 
001195 
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ELSE 
|F upName = 'INTEGER' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 
END 
ELSE 
1F upName = 'HEXINTEG' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 


ELSE 
|F upName = 'LONGINT' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 
END 
ELSE 
1F upName = 'REAL' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 


ELSE 
|F upName = 'POINT' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 
END 
ELSE 
1F upName = 'PTR' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 


ELSE 
1F upName = 'LONGREAL' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 
END 
ELSE 
1F upName = 'LPOINT' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, 


ylnteger, 2, 0, 0, '') 


yHexInteger, 1, 0, 0, '') 


yLongint, 4, 0, 0, '') 


yReal, 4, 0, 0, '') 


yPoint, 4, 0, 0, '') 


yLongReal, 8, 0, 0, '') 


yLPoint, 8, 0, 0, '') 
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001196 
001197 
001198 
001199 
001200 
001201 
001202 
001203 
001204 
001205 
001206 
001207 
001208 
001209 
001210 
001211 
001212 
001213 
001214 
001215 
001216 
001217 
001218 
001219 
001220 
001221 
001222 
001223 
001224 
001225 
001226 
001227 
001228 
001229 
001230 
001231 
001232 
001233 
001234 
001235 
001236 
001237 
001238 
001239 
001240 
001241 
001242 
001243 


END; 
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ELSE 
1F upName = 'RECT' THEN 
BEGIN 
1F NOT inhibited THEN 
FoundType(typeName, yRect, 8, 0, 0, '') 
END 
ELSE 
1F upName = 'LRECT' THEN 
BEGIN 
1F NOT inhibited THEN 


FoundType(typeName, yLRect, 16, 0, 0, '') 


ELSE 
BEGIN 
IF Ci OfCn(upName) > 0 THEN 
BEGIN 
word := token; 
StrUpperCased( @word); 
1F word = 'OF' THEN 
BEGIN 
pp := Pp; 
Next Token: 
ParseType( TRUE); 
1F NOT inhibited THEN 


FoundType(typeName, yObject, SIZEOF(Handle), 0, 0, Copy(inStr, pp, start - 


END 
ELSE 
1F NOT inhibited THEN 


FoundType(typeName, yObject, SI ZEOF( Handle), 


END 
ELSE 
FoundUnexpected(typeName, 'typename' ) 
END; 
inhibited := wasl nhibited 


PROCEDURE ParseFiel d; 


BEGI 


N 

1F NOT alpha THEN 
BEGIN 
FoundUnexpected(token, ‘var name'); 
Next Token: 
END 

ELSE 
BEGIN 
1F NOT inhibited THEN 

FoundName( token); 

Next Token: 


Apple Lisa ToolKit 3.0 Source Code Listing 


0, 


0, 


Sols 


708 of 1012 


pp)); 
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001244 Expect(':'); 

001245 ParseType( FALSE); 

001246 IF token = ';' THEN 

001247 Next Token 

001248 ELSE 

001249 IF (token <> '') AND (token <> 'END') THEN 
001250 FoundUnexpected(token, '; or END'); 
001251 END; 

001252 END; 

001253 

001254 BEGIN 

001255 inhibited := FALSE: 

001256 p:=l; 

001257 eoi := Length(inStr); 

001258 Insert(' ', inStr, Length(inStr) + 1); {So that inStr[eoi+l] won't blow up} 
001259 Next Token: 

001260 WHILE token <> '' DO 

001261 ParseField; 

001262 END; 

001263 

001264 

001265 PROCEDURE WriteDRecord{(numLevels: | NTEGER; hDRecord: Handle; poslnDRecord: INTEGER; 
001266 PROCEDURE Suppl yFields( PROCEDURE Field(nameAndType: $255)))}; 
001267 

001268 VAR fieldinDRecord: INTEGER 

001269 

001270 PROCEDURE WrCkAbort; 

001271 BEGIN 

001272 IF KeyPress THEN 

001273 BEGIN 

001274 WStr('...abort...'); 

001275 EX! T( Writ eDRecord) 

001276 END; 

001277 END: 

001278 

001279 PROCEDURE Decl Name(token: $8); 

001280 BEGIN 

001281 Wr CkAbort; 

001282 WrStr(Concat(token, ': ')); 

001283 END: 

001284 

001285 PROCEDURE Ski pName(token: S8) 

001286 BEGIN 

001287 Wr CkAbort; 

001288 END; 

001289 

001290 PROCEDURE Decl Bad(token, wanted: $8); 

001291 BEGIN 
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001292 Wr CkAbort; 

001293 WrLn; 

001294 WrStr('<<The Field proc expected: ') 

001295 WrStr(Concat(' ''', wanted, ''' ')); 

001296 WrStr('but encountered: ') 

001297 WrStr(Concat(' ''', token, '''>>')); 

001298 END; 

001299 

001300 PROCEDURE Decl Type(token: $8; typeCode: TTypeCode; numBytes: INTEGER 
001301 lowerBound, upperBound: INTEGER; memberTypeStr: $255); FORWARD; 
001302 

001303 PROCEDURE Decl Array(token: $8; lowerBound, upperBound: INTEGER; memberTypeStr: $255); 
001304 VAR strl: $8 

001305 str: $8; 

001306 i: | NTEGER; 

001307 ori gPos: INTEGER; 

001308 BEGIN 

001309 1F Odd( posi nDRecord) THEN 

001310 posinDRecord := posinDRecord + 1; 

001311 IntToStr(lowerBound, @str1l) 

001312 IntToStr(upperBound, @str2) 

001313 WrStr(Concat(token, ' [', stril, '..', str2, '] = {')); 

001314 FOR i := |owerBound TO upperBound DO 

001315 BEGIN 

001316 IF i > lowerBound THEN 

001317 WStr(', '): 

001318 origPos := posi nDRecord 

001319 IntToStr(i, @str1); 

001320 ParseDecl(CONCAT(stri, ': ', memberTypeStr), Decl Name, Decl Type, Decl Bad) 
001321 (***** 

001322 1F Odd( posi nDRecord) THEN 

001323 posi nDRecord := posinDRecord + 1; 

001324 *****) 

001325 END; 

001326 Wr Str('}'); 

001327 END; 

001328 

001329 PROCEDURE Decl Type(token: $8; typeCode: TTypeCode; numBytes: INTEGER 
001330 lowerBound, upperBound: INTEGER; memberTypeStr: $255) 
001331 TYPE 

001332 TAlias = 

001333 RECORD 

001334 CASE TTypeCode OF 

001335 yByte: (asByte: Byte); 

001336 yChar: (asChar: CHAR); 

001337 yl nteger: (asInteger: INTEGER) 

001338 yLongl nt: (asLongl nt: LONGI NT) 

001339 yLPoint: (asLPoint: FakeLPoi nt) 
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001340 yLRect: (asLRect: FakeLRect); 
001341 yObject: (asObject: TObject); 
001342 yPoint: (asPoi nt: FakePoi nt); 
001343 yReal: (asReal: REAL); 
001344 yRect: (asRect: FakeRect); 
001345 yString: (asString: $255); 
001346 END; 

001347 VAR alias: “TAlias; {a bona fide use for aliasing instead of typecasting} 
001348 obj: TObj ect; 

001349 str: $255: 

001350 i: INTEGER; 

001351 BEGIN 

001352 IF typeCode = yArray THEN 

001353 BEGIN 

001354 DeclArray(token, |owerBound, upperBound, memberTypeStr); 
001355 EXIT( Decl Type); 

001356 END; 

001357 

001358 IF token <> '' THEN 

001359 WreStr(Concat(token, ' = ')); 

001360 

001361 IF numBytes > 1 THEN 

001362 1F Odd( posi nDRecord) THEN 

001363 posi nDRecord := posinDRecord + 1; 

001364 

001365 alias := POINTER(ORD( hDRecord*) + posinDRecord); {Careful, this is a relocatable location! } 
001366 str ist: 

001367 CASE typeCode OF 

001368 yPtr: BEGIN 

001369 LI ntToHex(alias*.asLongl nt, @str); 
001370 str := Concat('$', str) 

001371 END; 

001372 yBool ean: IF alias*.asByte = ORD(FALSE) THEN 
001373 str := 'FALSE' 

001374 ELSE 

001375 str := 'TRUE'; 

001376 yByte: IntToStr(alias*.asByte, @str) 
001377 yHexByte: BEGIN 

001378 LI ntToHex(alias*.asByte, @str) 
001379 str := CONCAT('$', Copy(str, 7, 2)) 
001380 END; 

001381 yChar: BEGIN 

001382 str :='A'; 

001383 str[1] := alias*. asChar 

001384 END; 

001385 yl nteger: IntToStr(alias*.asinteger, @str) 
001386 yHexI nteger: BEGIN 

001387 LI ntToHex(alias*.asInteger, @str); 
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001388 
001389 
001390 
001391 
001392 
001393 
001394 
001395 
001396 
001397 
001398 
001399 
001400 
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str := CONCAT('$', Copy(str, 5, 4)); 


END; 
yLongl nt: LI ntToStr(alias*.asLongl nt, @str); 
yLPoint: LPointToStr(alias*.asLPoint, @str) 
yLRect: LRectToStr(alias*.asLRect, @str); 
yObject: BEGIN 

obj := alias*. asObj ect 

LI ntToHex(ORD(obj), @str) 

str := Concat('$', str, ' -- '); 

1F obj = NIL THEN 


str := 'NIL' 
ELSE | F NOT ValidObj ect(Handle(obj)) THEN 

str := Concat(str, ‘Invalid Object') 
ELSE 

BEGIN 

WrStr(str); 

str :=''3 

obj. Debug(numLevels - 1, memberTypeStr); 


END; 
yPoint: PointToStr(alias*.asPoint, @str); 
yRect: RectToStr(alias*.asRect, @str); 
yString: BEGIN 
str := Concat('''', alias*.asString, '''') 
1F Odd(numBytes) THEN 
numBytes := numBytes + 1; 
END; 
yReal: BEGIN 


LI ntToStr(Round(alias*.asReal * 1000.0), @str); 


FOR i := LENGTH(str) TO 3 DO 
Insert('0', str, 1); 
Insert('.', str, LENGTH(str)-2); 


END; 
OTHERWISE Decl Bad(token, ‘'typename' ); 
END; 
Wr CkAbort; 


IF str <> '' THEN 
WStr(Concat(str, ' ')); 


posi nDRecord := posInDRecord + numBytes 


END; 
PROCEDURE DebugField(nameAndType: $255) 
BEGIN 

IF nameAndType <> '' THEN 


BEGIN 
fieldinDRecord := fieldInDRecord + 1; 


Apple Lisa ToolKit 3.0 Source Code Listing -- 712 of 


1012 


001436 
001437 
001438 
001439 
001440 
001441 
001442 
001443 
001444 
001445 
001446 
001447 
001448 
001449 
001450 
001451 
001452 
001453 
001454 
001455 
001456 
001457 
001458 
001459 
001460 
001461 
001462 
001463 
001464 
001465 
001466 
001467 
001468 
001469 
001470 
001471 
001472 
001473 
001474 
001475 
001476 
001477 
001478 
001479 
001480 
001481 
001482 
001483 


Apple Lisa Computer Technical Information 


IF fieldinDRecord > 1 THEN 


WrStr('; '); 
ParseDecl(nameAndType, Decl Name, Decl Type, Decl Bad); 
Wr CkAbort; 


END 
ELSE {Empty string signifies padding to a word boundary, if necessary} 
1F Odd( poslnDRecord) THEN 
posinDRecord := posi nDRecord + 1; 
END; 


BEGIN 
IF KeyPress THEN 
Exit(WriteDRecord) 


fieldinDRecord := 0; 


WeStr('[ '); 
Suppl yFields(DebugField); 
WeStr('] '); 


END; 


PROCEDURE DumpVar{(pVariable: Ptr; nameAndType: $255) }; 


PROCEDURE Suppl yVar( PROCEDURE Field(nameAndType: $255)); 


BEGIN 
Fiel d(nameAndType); 
END; 
BEGIN 
currXPos := 0; 


outputindent := 20 
WriteDRecord(1, @pVariable, 0, SupplyVar); 
outputindent := 0 
Wren: 
END; 
{$ENDC} 


{$1 FC fDbgObj ect} 
PROCEDURE WrStr{(str: $255) }: { Write a STRING with word-wrap } 
VAR start: INTEGER; 
maxLen: INTEGER 
len: INTEGER; 
total: INTEGER 
BEGIN 
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total := Length(str); 
start := 1; 
WHILE start <= total DO 
BEGIN 
len := total - start + 1; 
maxLen := outputRMargin - currXPos 
IF len > maxLen THEN 
BEGIN 
len := maxLen; 
WHILE (len > 0) AND (str[len] <> ' ') DO 
len :=len- 1; 
1F (len = 0) AND (currXPos = outputIindent) THEN 
len := maxLen; 
END; 
IF len > 0 THEN 
BEGIN 
Write(Copy(str, start, len)); 
currXPos := currXPos + len; 
start := start + len; 
END; 
IF (currXPos >= outputRMargin) OR (start <= total) THEN 
Wr Ln: 
END; 
END; 


PROCEDURE WrLn; { goto next line and output indentation } 
BEGIN 
WiteLn; 
IF outputindent > 0 THEN 
BEGIN 
Write(' ':outputI ndent); 
currXPos := outputl ndent; 
END 
ELSE 
currXPos := 0 
END; 


FUNCTION CheckKeyPress{(routine: $255): BOOLEAN}; 
VAR ch: CHAR; 
BEGIN 
IF KeyPress THEN 
BEGIN 
IF routine <> '' THEN 
BEGIN 
WriteLn; 
WriteLn(' -- ', routine, ' stopped because you typed a key --') 
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WriteLn; 
END; 
(* commented out and should be removed if paslib bug has been fixed 
{ flush characters; because of PASLIB bug, also stop when user types a ~ } 
chia! '; 
WHILE KeyPress AND (ch<>'~') DO 
IF EQLn THEN 
ReadLn 
ELSE 
Read(ch); 


CheckKeyPress := TRUE; 
END 
ELSE 
CheckKeyPress := FALSE; 
END; 


{$1 FC fDebugMet hods} 
PROCEDURE WrObj (object: TObject; numLevels: INTEGER; memberTypeStr: $255) 
BEGIN 
WiteLn; 
currXPos := 0; 
outputindent := 0 
IF ValidObj ect(Handle(object)) THEN 
BEGIN 
object. Debug(numLevels, memberTypeStr); 
1F CheckKeyPress('Display of the object’) THEN 
END 
ELSE 
Write('Not an object: ', ORD(object):1); 
END; 
{$ENDC} 


{$$ SgCLAi ni} 


PROCEDURE DumpHeap(heap: THeap; wantedSTP: LONGINT; wantedReference: LONGINT; fPrintSelf: 


VAR hz: THz; 
ch: TC; 
hndl: Handle; 
obj: TObj ect; 
heapSi ze: LONGI NT; 
numObj ects: LONGI NT; {Clascal objects only} 
obj OvhdSi ze: LONGI NT; {includes master, header, and class pointer} 
obj DataSi ze: LONGI NT; 
numOt her: LONGI NT; {Non-Clascal objects} 
other Size: LONGI NT; 
numFree: LONGI NT; 


BOOLEAN); 


Apple Lisa ToolKit 3.0 Source Code Listing -- 715 of 1012 


Apple Lisa Computer Technical Information 


001580 freeSize: LONGI NT; 

001581 bi gFreeSi ze: LONGI NT; 

001582 bk: TBk; 

001583 dumpl t: BOOLEAN; 

001584 valid: BOOLEAN; 

001585 offset: INTEGER; 

001586 base: LONGI NT; 

001587 hStr: $8; 

001588 class: TClass; 

001589 className: TCl assName: 

001590 BEGIN 

001591 WriteLn; 

001592 

001593 1F heap = NIL THEN 

001594 BEGIN 

001595 WriteLn('The heap pointer is NIL'); 
001596 WriteLn; 

001597 EXIT( DumpHeap); 

001598 END; 

001599 

001600 hz := THz( heap); 

001601 heapSize := cbhOfHz(hz); 

001602 

001603 numObjects := 0; 

001604 obj OvhdSize := 0; 

001605 obj DataSize := 0; 

001606 numOther := 0; 

001607 otherSize := 0; 

001608 numFree := 0; 

001609 freeSize := 0; 

001610 bigFreeSize := 0; 

001611 

001612 WriteLn('Heap size in bytes: ', heapSize: 6); 
001613 WriteLn(' Bytes free: ', hz*. cbFree: 6); 
001614 WiteLn; 

001615 

001616 WriteLn('Heap contents (handle, size in bytes):'); 
001617 WriteLn; 

001618 

001619 { setup indentation for writing objects } 
001620 outputindent := 17; { '$', ORD(hndl):8, cb:6, ': ' } 
001621 

001622 bk := hz’, bkFst; 

001623 WHILE (ORD(bk) >= ORD(hz*. bkFst)) AND (ORD( bk) <= ORD(hz*. bkLst)) DO 
001624 BEGIN 

001625 IF bk*. hdr. tybk <> tybkFree THEN 

001626 ch := bk*.hdr.cw * 2 

001627 ELSE 
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001628 ch := bk*.cwFree * 2; 

001629 

001630 IF ch <= 0 THEN 

001631 BEGIN 

001632 WriteLn('FREE BLOCK ', ORD(bk):1, ' HAS LENGTH', cb); 
001633 EXI T( DumpHeap); 

001634 END; 

001635 

001636 CASE bk*. hdr. tybk OF 

001637 

001638 tybkStd: 

001639 BEGIN 

001640 {$IFC LibraryVersion <= 20} 

001641 hndl := Handle(ORD(hz) + bk%. oh) 

001642 {$ELSEC} 

001643 hnd] := Handle(ORD( @hz*.argpPool) + (LONGI NT( bk*. bp. ip)*4)); 
001644 {$ENDC} 

001645 valid := Vali dObj ect(hndl ) 

001646 

001647 1F wantedSTP > 0 THEN 

001648 IF valid THEN {looks like a class pointer; pray that it is!} 
001649 dumplt := % InObCp(ORD(hndl), wantedSTP) 
001650 ELSE 

001651 dumplt := FALSE 

001652 ELSE 

001653 1F wantedReference <> 0 THEN 

001654 BEGIN 

001655 offset := 0; 

001656 base := ORD(hndl *) 

001657 WHILE (offset < cb) AND (TpLONGINT( base + offset)* <> wantedReference) DO 
001658 offset := offset + 2; 

001659 dumplt := offset < cb 

001660 END 

001661 ELSE 

001662 dumplt := TRUE; 

001663 

001664 1F dumplt THEN 

001665 BEGIN 

001666 Lint ToHex(ORD(hndl), @hStr) 

001667 Write('$', hStr, cbh:6, ': '); 

001668 IF bk <> TBk(ORD(hndl *) - 4) THEN 

001669 BEGIN 

001670 WriteLn(' INCORRECT BACK POINTER FOR bk = ', ORD( bk): 1) 
001671 EXI T( DumpHeap) 

001672 END; 

001673 

001674 IF valid THEN 

001675 BEGIN 
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obj := TObject(hndl); 
currXPos := outputl ndent; 
{$1 FC fDebugMet hods} 


IF fPrintSelf THEN 
obj. Debug(1, '') 
E 


ELS 

obj.Debug(0, ''); 
{$ELSEC} 
class := obj.Class; 


CpToCn(TPSliceTable(class), TS8(className) ) 
Tri mBl anks( @cl assName); 

Write(className); 

{$ENDC} 


numObjects := numObjects + 1; 
obj OvhdSize 
obj DataSize 
END 

ELSE 
BEGIN 
numOther := numOther + 1; 
otherSize := otherSize + cb 
Write('???'); 
END; 


obj DataSize + ch-4; {classPtr=4} 


WriteLn; 
END; 


obj OvhdSize + 12; {master=4, header =4 


classPtr=4} 


bk := TBk(ORD(hndIl*) - 4); {in case the heap compacted during obj. Debug} 


END; 


tybkFree: 
BEGIN 
numFree := numFree + 1; 
freeSize := freeSize + cb; 
IF ch > bigFreeSize THEN 
bigFreeSize := cb; 
END; 


OTHERW SE 
BEGIN 
numOther := numOther + 1; 
otherSize := otherSize + ch; 
END; 

END; 


bk := TBk(ORD( bk) + cb); 
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001724 

001725 1F CheckKeyPress('HeapDump') THEN 

001726 EXI T( DumpHeap); 

001727 END; 

001728 WriteLn; 

001729 

001730 IF numObjects > 0 THEN 

001731 BEGIN 

001732 WriteLn('Number of Clascal objects: ', numObj ects: 6) 
001733 IF wantedReference = 0 THEN 

001734 BEGIN 

001735 WriteLn('Bytes in their headers & masters: ', obj OvhdSize: 12) 
001736 WriteLn('Bytes in their records: ', obj DataSize: 12) 
001737 1F obj DataSize+obj OvhdSize > 0 THEN 

001738 WriteLn('Header and master overhead: 

001739 (100 * obj OvhdSize) DIV ian becediaassiovnisiaeiy 5, '%'); 
001740 END; 

001741 WriteLn; 

001742 END; 

001743 

001744 IF (wantedSTP <= 0) AND (wantedReference = 0) THEN 

001745 BEGIN 

001746 WriteLn('Number of free blocks: ', numFree: 6) 

001747 WriteLn('Largest free block: ', bigFreeSize: 6) 
001748 WriteLn('Bytes in free blocks: ', freeSize:12) 

001749 WriteLn; 

001750 WriteLn('Number of other blocks: ', numdt her: 6) 

001751 WriteLn('Bytes in those blocks: ', otherSize: 12) 

001752 WriteLn; 

001753 WriteLn('Other overhead: ', heapSize-obj OvhdSi ze-obj DataSize-freeSize-otherSi ze: 12) 
001754 WriteLn('Total heap size in bytes: ', heapSize:12) 

001755 WriteLn; 

001756 END; 

001757 END; 

001758 

001759 


001760 {$8 SgCLAi ni } 

001761 PROCEDURE GokitBug; {intended to be called from LisaBug} 
001762 BEGIN 

001763 EntDebugger(' ', ‘Called from GoKitBug'); 

001764 END; 

001765 

001766 

001767 {$S SgCLAi ni } 

001768 PROCEDURE EntDebugger{(inputStr, enterReason: $255) }; 


001769 LABEL 99 
001770 CONST null = CHR(0); 
001771 VAR token: $255; 
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cState: TConvResult; 
ti meToGo: BOOLEAN; 
brClass: $8; 


br Met hod: $8; 


PROCEDURE Get Token: 
VAR endOf Token: INTEGER 


BEGIN 
token :='': 
WHILE Pos(' ', inputStr) = 1 DO 
Delete(inputStr,1, 1); 
endOf Token := Pos(' ', inputStr)-1; 


1F endOfToken <= 0 THEN 
endOf Token := Length(inputStr); 
token := Copy(inputStr, 1, endOfToken); 
Delete(inputStr, 1, endOf Token); 
END; 


PROCEDURE DebugStatus 
VAR i: INTEGER; 


BEGIN 
IntToStr(curTraceLevel, @token); 
Write('Watch Level = ', token) 
IntToStr(defTraceCount, @token); 
WriteLn(', Watch Count = ', token) 
FOR i := 1 TO breakMCount DO 
WITH breakMethods[i] DO 
IF (brClass <> '') OR (brMethod <> '') THEN 
WriteLn(i:3, ': ', brClass:8,'.', brMet hod: 8) 
END; 
PROCEDURE Clear Breaks 
VAR brNumber: INTEGER 
cState: TConvResult; 
BEGIN 
Get Token; 
1F token = '' THEN 
BEGIN 
Write('Clear which breakpoint [A for all breakpoints]? '); 
ReadLn(token); 
END; 


Tri mBl anks( @token); 
StrUpperCased( @t oken) 


IF token <> '' THEN 


IF token[1] = 'A' THEN 
breakMCount := 0 
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001820 ELSE 

001821 BEGIN 

001822 StrTolnt(@token, brNumber, cState) 

001823 IF cState = cvValid THEN 

001824 1F (brNumber >= 1) AND (brNumber <= breakMCount) THEN 
001825 WITH breakMethods[brNumber] DO 

001826 BEGIN 

001827 brClass :=''3 

001828 brMethod :='' 

001829 

001830 1F brNumber = breakMCount THEN 
001831 breakMCount := breakMCount - 1; 
001832 END; 

001833 END; 

001834 END; 

001835 

001836 { get input up to the first '.'; if non-null convert to 8 characters 
001837 prompt user with argument if there is no pending input } 
001838 PROCEDURE Get One( prompt: $255); 

001839 VAR i: INTEGER 

001840 BEGIN 

001841 Get Token; 

001842 

001843 1F token = '' THEN 

001844 BEGIN 

001845 Wri te( prompt) 

001846 ReadLn(token); 

001847 END; 

001848 

001849 i := Pos('.', token); 

001850 

001851 IF i > 0 THEN 

001852 BEGIN 

001853 inputStr := Concat(Copy(token, i + 1, Length(token) - i), inputStr); 
001854 token := Copy(token, 1, i - 1); 

001855 END; 

001856 

001857 Tri mBl anks( @t oken) 

001858 IF token <> '' THEN 

001859 BEGIN 

001860 StrUpperCased( @token) 

001861 token := Copy(Concat(token, ' '), 1, 8); 
001862 END; 

001863 END; 

001864 

001865 PROCEDURE BrSetup(prompt: S255) 

001866 VAR brNumber: INTEGER 

001867 
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FUNCTION MoreThanAClass: Boolean; 
BEGIN 
MoreThanACl ass := TRUE; 
IF length(inputstr) > 0 THEN 
IF inputstr[length(inputstr)] = '.' THEN 
BEGIN 
Get One(Concat(prompt,' what Class?')); 
WITH breakMethods[brNumber] DO 


BEGIN 
brClass := token; 
brMethod :=''; 
END; 
MoreThanACl ass := FALSE; 
END; 
END; 
BEGIN 


FOR brNumber := 1 TO maxBreaks DO 
WITH breakMethods[ brNumber] DO 
1F (brNumber > breakMCount) OR ((brClass='') AND (brMethod='')) THEN 
BEGIN 
1F MoreThanAClass THEN 
BEGIN 
Get One(Concat(prompt,' what Class?')); 
brClass := token; 
Get One(Concat(prompt,' what Method?')); 
brMethod := token; 


END; 
IF (brClass <> '') OR (brMethod <> '') THEN 
breakMCount := Max(breakMCount, brNumber) 
lastBpPc := 0; 
lastEpPc := 0; 


EXIT(BrSetup); 
E ' 


WriteLn('Too Many Breaks Defined, you must first clear a breakpoint' ) 
END; 


PROCEDURE TraceOrNot; 
VAR i: INTEGER; 
BEGIN 
Get Token; 
StrTolnt(@token, i, cState); 
IF cState = cvValid THEN 
BEGIN 
defTraceCount := i; 
Get Token; 
END 
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ELSE 
defTraceCount := 0; 


returnToMain := TRUE; 
fTraceSelf := FALSE; 
fTraceClass := FALSE; 
WHILE token <> '' DO 
BEGIN 
StrUpperCased( @token); 
IF token[1] = 'A' THEN {Stay on Alternate Screen During Trace} 
returnToMain := FALSE 
ELSE 
IF token[1] = 'C' THEN {Print Class with Trace} 
fTraceClass := TRUE 
ELSE 
IF token[1] = 'F' THEN {Print Fields with Trace} 
fTraceSelf := TRUE: 
Get Token; 
END; 


fTraceEnabled := TRUE; 
traceCount := defTraceCount; 
END; 


PROCEDURE Level 
VAR i: INTEGER; 


BEGIN 

Get Token; 

IF token = '' THEN 
BEGIN 
Write('Lowest BP level to watch (1..9999)? '); 
ReadLn(token); 
END: 

StrTolnt(@token, i, cState); 


IF cState = cvValid THEN 
1F (i >= 1) AND (i <= 32000) THEN 
curTraceLevel := i; 


END: 
FUNCTION YesNo( prompt: $255): BOOLEAN 
BEGIN 
REPEAT 
Get One(Concat(prompt, '? [Y/N]: ')); 
IF token = '' THEN 
GOTO 99; 


UNTIL token[1] IN ['Y', 'N'] 
YesNo := token[1] = 'Y' 
END; 
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PROCEDURE Prompt OnOff; 
BEGIN 

showPrompt := YesNo('Show Debugger Prompt' ) 
END; 


{$1 FC fDebugMet hods} 
PROCEDURE Inspect; 
VAR Ih: LONGI NT; 

d: INTEGER; 

BEGIN 

Get Token; 

IF token = '' THEN 
BEGIN 
Write('Handle to inspect [depth] [member decl]? '); 
Readi n(inputStr); 
Get Token; 

END; 


HexStrToLIint(@token, Ih, cState); 
IF cState <> cvValid THEN 
BEGIN 
WriteLn('Not a hex number'); 
Exit(Inspect); 
END 
ELSE 
Get Token; 


StrTolnt(@token, d, cState); 
IF cState <> cvValid THEN 
d:=l; 


IF ValidObj ect(Handle(Ih)) THEN 
BEGIN 
Wr Obj (TObject(Ih), d, inputStr); 
Writeln; 
END 
ELSE 
Writeln('Invalid Object'); 
Writeln; 
END; 
{$ENDC} 


PROCEDURE Tall yAndTi me; 
BEGIN 
tallyingCalls := FALSE; 
I1F tallies <> NIL THEN 
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BEGIN 

IF YesNo('Do you want to see performance measurements now') THEN 
Tall yReport; 

IF YesNo('Do you want to zero the tallies and times') THEN 
Tall yZero; 

END; 


IF YesNo('Do you want to continue execution and measure its performance’) THEN 


TallyStart; 
WriteLn; 


PROCEDURE Ref sToObj ect; 


VAR 
BEGI 


END; 


Ih: LONGI NT; 

N 

Get Token; 

IF token = '' THEN 
BEGIN 


Write('Handle of the object whose every Reference fromthe same heap should be dumped? '); 


Readi n(inputStr); 
Get Token; 
END; 


HexStrToLInt(@token, Ih, cState); 
IF cState <> cvValid THEN 
BEGIN 
WriteLn('Not a hex number'); 
Exit( RefsToObj ect); 
END; 


IF ValidObj ect(Handle(Ih)) THEN 
DumpHeap(TObject(Ih).Heap, -1, Ih, TRUE) 
ELSE 
Writeln('Invalid Object'); 
Writeln; 


FUNCTION StackFrame(whichFrame: | NTEGER): LONGINT; 


{ Returns address of stack frame 'whichFrame' (>=-1); 
whichFrame < 0 returns -1. 


whichFrame = 1 is the top frame not belonging to the debugger itself. 


When called from ABCBREAK, the caller of ABCBREAK is frame 1; 
When called from BEPSN, the caller of BP or EP is frame 1. 
whichFrame = 2 is the caller of frame 1, and so on 
lf whichFrame is greater than # frames, returns -1, 
If neither ABCBREAK nor BEPSN is on the stack, returns -1, } 


VAR dummy: | NTEGER; { must be first local and two bytes long } 
RAG: LONGI NT; 
RA5: LONGI NT; 


Apple Lisa ToolKit 3.0 Source Code Listing 


725 of 1012 


Apple Lisa Computer Technical Information 


002060 i: | NTEGER; 

002061 className: TCl assName: 

002062 procName: $8; 

002063 startCount: BOOLEAN 

002064 frameReference: INTEGER 

002065 nextPC: LONGI NT; 

002066 BEGIN 

002067 StackFrame := -1; { default return } 

002068 frameReference := 0: 

002069 startCount := FALSE; 

002070 

002071 RA5 := % GetA5; 

002072 RAG : = ORD( @dummy) +2; { stack frame called by current one; start with my stack frame } 
002073 WHILE (whichFrame >= frameReference) AND (RA6 <> RAS) DO 
002074 BEGIN 

002075 1F NOT startCount THEN 

002076 BEGIN 

002077 IF GetDollarD(TppINTEGER( RAG), className, procName, nextPC) THEN { is this frame 0? } 
002078 1F (className = ''') AND ((procName = 'BEPSN ') OR (procName = ' ABCBREAK')) THEN 
002079 BEGIN 

002080 startCount := TRUE; { yes } 

002081 1F procName = 'BEPSN ' THEN 

002082 frameReference := -1; 

002083 END; 

002084 END; 

002085 

002086 RA6 : = TpLONGI NT( RAG) *; { preceding stack frame } 
002087 

002088 IF startCount THEN 

002089 BEGIN 

002090 1F whichFrame = frameReference THEN 

002091 StackFrame := RA6 

002092 whichFrame := whichFrame - 1: 

002093 END; 

002094 END; 

002095 END: 

002096 

002097 PROCEDURE WrMemory(start: LONGINT; numBytes: INTEGER; checkAddresses: BOOLEAN) 
002098 VAR addr: LONGI NT; 

002099 str: $255; 

002100 asChars: STRING[ 16]; 

002101 extdWord: LONGI NT; 

002102 overflow: BOOLEAN 

002103 fullBytes: INTEGER 

002104 

002105 FUNCTION Byte2Char(n: INTEGER): CHAR 

002106 BEGIN 

002107 IF (n < 32) OR (n > ORD('~')) THEN 
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002108 Byte2Char := 'e' 

002109 ELSE 

002110 Byte2Char := CHR(n) 

002111 END; 

002112 

002113 $R- } 

002114 PROCEDURE AddCh(s: TPString; ch: CHAR; maxStrLeng: INTEGER; VAR overflow: BOOLEAN); 
002115 BEGIN 

002116 overflow := TRUE: 

002117 IF Length(s*) < maxStrLeng THEN 

002118 BEGIN 

002119 overflow := FALSE: 

002120 s*[0] := CHR(ORD(s*[0]) + 1) 

002121 s*[ORD(s*[0])] := ch; 

002122 END; 

002123 END: 

002124 {$1 FC fRngObj ect} {$R+} {$ENDC} 

002125 

002126 BEGIN 

002127 { start at an even address and fullBytes a multiple of 16 >= numBytes } 
002128 

002129 addr := (start DIV 2) * 2; 

002130 

002131 IF checkAddresses THEN 

002132 1F NOT ValidDataAddress(addr) THEN 
002133 1F NOT ValidGlobalAddress(addr) THEN 
002134 BEGIN 

002135 WriteLn; 

002136 Write('*** That address is neither in a data segment nor in the stack/global segment. ') 
002137 WriteLn('***'); 

002138 EX! T( Wr Memory); 

002139 END; 

002140 

002141 full Bytes := ((numBytes + 15) DIV 16) * 16 
002142 

002143 WHILE full Bytes > 0 DO 

002144 BEGIN 

002145 IF full Bytes MOD 16 = 0 THEN 

002146 BEGIN 

002147 LintToHex(addr, @str); 

002148 Write(' ', str, ' ‘); 

002149 asChars :=''3 

002150 END; 

002151 

002152 IF checkAddresses THEN 

002153 1F NOT ValidDataAddress(addr) THEN 
002154 1F NOT ValidGlobal Address(addr) THEN 
002155 WHILE numBytes > 0 DO 
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002156 
002157 
002158 
002159 
002160 
002161 
002162 
002163 
002164 
002165 
002166 
002167 
002168 
002169 
002170 
002171 
002172 
002173 
002174 
002175 
002176 
002177 
002178 
002179 
002180 
002181 
002182 
002183 
002184 
002185 
002186 
002187 
002188 
002189 
002190 
002191 
002192 
002193 
002194 
002195 
002196 
002197 
002198 
002199 
002200 
002201 
002202 
002203 
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BEGIN 
Write('eeee '): 


AddCh(@asChars, '*', 16, overflow); 
AddCh(@asChars, '*', 16, overflow); 


numBytes := numBytes - 2; 
full Bytes := fullBytes - 2; 
END; 


IF numBytes <= 0 THEN 
WHILE full Bytes > 0 DO 


BEGIN 
Write(' '); 
AddCh(@asChars, ' ', 16, overflow); 
AddCh( @asChars, ' ', 16, overflow); 
full Bytes := fullBytes - 2; 
END; 
IF full Bytes > 0 THEN 
BEGIN 
extdWord := LintAndLInt(TpINTEGER(addr)*, $OOOOFFFF) 


Li ntToHex(extdWord, @str) 
Delete(str, 1, 4); {4 leading zeros} 
Write(str, ' '); 


AddCh(@asChars, Byte2Char(extdWord DIV 256), 16, overflow); 
AddCh(@asChars, Byte2Char(extdWord MOD 256), 16, overflow); 


addr := addr + 2: 


full Bytes := fullBytes - 2; 
numBytes := numBytes - 2; 
END; 
IF full Bytes MOD 16 = 0 THEN 
WriteLn(' |', asChars, '|'); 
END; 
WriteLn; 


END; 


FUNCTION WrFrame(whichFrame: INTEGER; full: BOOLEAN): 


BOOLEAN; 


{ Wite a frame given its number; return TRUE if that frame exists } 


VAR RAS: LONGI NT; 
calledA6: LONGI NT; 
addr: LONGI NT; 
later A6: LONGI NT; 
earlierA6: LONGI NT 
hexStr: $8; 
got Mai nProg: BOOLEAN; 
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002204 
002205 
002206 
002207 
002208 
002209 
002210 
002211 
002212 
002213 
002214 
002215 
002216 
002217 
002218 
002219 
002220 
002221 
002222 
002223 
002224 
002225 
002226 
002227 
002228 
002229 
002230 
002231 
002232 
002233 
002234 
002235 
002236 
002237 
002238 
002239 
002240 
002241 
002242 
002243 
002244 
002245 
002246 
002247 
002248 
002249 
002250 
002251 
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BEGIN 


className: TCl assName: 
met hName: $8; 
procName: $255; 
procStart: LONGI NT; 
frameSELF: TObj ect; 
class: TClass; 
nextPC: LONGI NT; 
local Bytes: INTEGER; 
paramBytes: INTEGER; 
selfBytes: INTEGER; 
PROCEDURE SwapIn(valueString: $8); 
BEGIN 
END; 
RA5 := % GetA5; 
calledA6 := StackFrame( whichFrame- 1); { A6 of frame called by desired frame } 
1F (whichFrame < 1) OR (calledA6 = -1) OR (calledA6 = RA5) THEN 
BEGIN 


WrFrame := FALSE; 
EX! T( WrFrame); 
END; 

WrFrame := TRUE; 


addr := calledA6; 

LI nt ToHex( TpLONGI NT(addr)*, @hexStr); 

Write('Frame #', whichFrame:3, ' @$', hexStr, ' '): 

gotMainProg := TpLONGINT(addr)* = RAS; { stack frame for main prog starts at A5 } 


{ find called-from address } 
IF Get Doll arD(TppINTEGER(calledA6), className, methName, nextPC) THEN 


1F className = '' THEN 
procName := met hName 
ELSE 
procName := Concat(className, '.', methName) 
ELSE 
procName :=''; 


IF procName <> '' THEN 
BEGIN 
Write(procName: 17); 


{ search back in code for TST. W <n>(A7) and LINK A6, <m> instructions } 
addr := call edA6+4; 
addr := TpLONGINT( addr) *; 


{$R-} Swapln(TPS8(addr)*); {$l1FC fRngObject} {$R+} {$ENDC} {Be sure the code is swapped in} 


procStart := 0; 
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002252 WHILE procStart = 0 DO 

002253 BEGIN 

002254 addr := addr - 2; 

002255 

002256 IF TpINTEGER(addr)* = $4656 { LINK A6,<n> } THEN 

002257 { found LINK, so numlLocal is now set correctly, and 

002258 start of PROCEDURE is 4 bytes back (auto stack expansion) } 
002259 procStart := addr - 4; 

002260 END; 

002261 

002262 1F gotMainProg THEN 

002263 procStart := procStart + 4; { main prog has no stack expansion } 
002264 

002265 addr := call edA6+4 

002266 LintToHex(TpLONGINT(addr)*-4 - procStart, @hexStr); 

002267 Delete(hexStr, 1, Length(hexStr)-4); { only want the lower 4 digits of hex number } 
002268 Write('+ $', hexStr); 

002269 

002270 { advance to next stack frame now, so we can get at its variables } 
002271 laterA6 := call edA6; 

002272 calledA6 := TpLONGI NT(l ater A6) *; 

002273 IF calledA6 = RAS THEN 

002274 earlierA6 := RAS 

002275 ELSE 

002276 earlierA6 := TpLONGI NT( call! edA6) *; 

002277 

002278 frameSELF := NIL; 

002279 1F (className <> '') AND (procName <> 'CREATE ') THEN { regular method } 
002280 BEGIN 

002281 addr := calledA6+8 

002282 IF ValidObj ect(Handl e( TpLONGI NT( addr) *)) THEN 

002283 frameSELF := TObj ect( TpLONGI NT( addr) *); 

002284 END; 

002285 

002286 IF frameSELF <> NIL THEN 

002287 BEGIN 

002288 Li nt ToHex( ORD(frameSELF), @hexStr); 

002289 class := frameSELF. Class; 

002290 CpToCn( TPSliceTable(class), TS8(className) ) 

002291 Write(' (', className, ': $', hexStr, ')') 

002292 END; 

002293 

002294 1F full THEN 

002295 BEGIN 

002296 {$1 FC fDebugMet hods} 

002297 WriteLn; 

002298 IF frameSELF <> NIL THEN 

002299 BEGIN 
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002300 
002301 
002302 
002303 
002304 
002305 
002306 
002307 
002308 
002309 
002310 
002311 
002312 
002313 
002314 
002315 
002316 
002317 
002318 
002319 
002320 
002321 
002322 
002323 
002324 
002325 
002326 
002327 
002328 
002329 
002330 
002331 
002332 
002333 
002334 
002335 
002336 
002337 
002338 
002339 
002340 
002341 
002342 
002343 
002344 
002345 
002346 
002347 
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Information 


Write('SELF = '); 
currXPos := 7: 
outputindent := 7; 
frameSELF.Debug(1, ''); 
WriteLn; 
END; 

{$ENDC} 


local Bytes : 
paramBytes : 
selfBytes := 4 * ORD(frameSELF <> NIL); 
WriteLn; 


Max(0, Min(ORD(calledA6 - (laterA6 + 8)), $50)); 
Max(0, Min(ORD(earlierA6 - (calledA6 + 8)), $50)); 


WriteLn('LOCALS (First declared local is listed last):'); 


WrMemory(calledA6 - local Bytes, local Bytes, FALSE); 


WriteLn('PARAMETERS (Last declared parameter is listed first):') 


END; 


WriteLn; 
END; 


PROCEDURE StackCrawl; 
VAR frNum: INTEGER; 
BEGIN 
frNum:= 1; 
WHILE WrFrame(frNum, FALSE) DO 
frNum:= frNum + 1: 
WriteLn; 
END; 


PROCEDURE FrameDump; 
VAR i: I NTEGER; 
frame: LONGI NT; 
BEGIN 
Get Token: 
IF token = ''' THEN 
BEGIN 
Write('Frame number to dump? '); 
ReadLn(token); 
END; 
StrTol nt( @token,i, cState); 
IF cState = cvValid THEN 
BEGIN 
1F (i >= 1) THEN 
1F NOT WrFrame(i, TRUE) THEN 
WriteLn('Frame number was too large'); 
END; 


WrMemory(calledA6 + 8 + selfBytes, paramBytes - self Bytes, FALSE); 
E 1 
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002348 WriteLn; 

002349 END; 

002350 

002351 PROCEDURE ToPri nter 

002352 VAR errnum: INTEGER 

002353 out fname: Pat hName 

002354 

002355 {$lFC LibraryVersion <= 20} 

002356 { Paslib initialization done in the WorkShop that is not done in the DeskTop manager } 
002357 PROCEDURE Tell PaslibPrinterLocati on; 

002358 CONST 

002359 AlreadyMounted = 1052; 

002360 

002361 VAR 

002362 errnum: INTEGER; { error return } 
002363 tp: TPORTS; 

002364 devname: E_Name; 

002365 vname: E_Name; 

002366 password: E_ Name; 

002367 tdt: TDeviceType 

002368 tdi: TDevicelnfo 

002369 dsp: DsProcParam 

002370 DevControl: DcType 

002371 path: Pat hName; 

002372 

002373 BEGIN 

002374 FOR tp := uppertwig TO t_extra3 DO 

002375 BEGIN 

002376 Get config name(errnum, tp, devname) 

002377 IF errnum <= 0 THEN 

002378 BEGIN 

002379 PMReadConfig(tp,tdt,tdi); 

002380 1F tdt IN [DMPrinter, Typer] THEN 

002381 BEGIN 

002382 Mount(errnum, vname, password, devname); 
002383 IF (errnum <= 0) or (errnum = AlreadyMounted) THEN 
002384 BEGIN 

002385 dsp. proccode := dsPrintDev 

002386 dsp.PrDevice := Concat('-', devname) 
002387 DSPasli bCall (dsp) 

002388 WITH DevControl DO 

002389 BEGIN 

002390 path := Concat('-',devname,'-x'); {0D} 
002391 dcversion := 2; 

002392 dccode := 17: {auto LF disable} 
002393 dcdata[0] := 13; 

002394 Device Control(errnum, path, DevControl) 
002395 CASE tp OF 
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002396 seriala, serial b: 

002397 BEGIN 

002398 dccode := 5; 

002399 dcdata[0] := 9600; 

002400 Device control(errnum, path, devcontrol); {baud rate} 
002401 dccode := 2; 

002402 Device control(errnum, path, devcontrol); {DTR} 
002403 dccode := 1; 

002404 dcdata[0] := 0; 

002405 Device control(errnum, path, devcontrol); {8-bit no-parity} 
002406 dccode := 12; 

002407 dcdata[0] := 60; 

002408 Device control(errnum, path, devcontrol); {time out} 
002409 dccode := 10: 

002410 dcdata[0] := 0; 

002411 dcdata[1l] := -128: 

002412 Device control(errnum, path, devcontrol); {disconnect detect} 
002413 END; 

002414 END {CASE} 

002415 END; 

002416 EX! T( Tell PaslibPrinterLocati on); 

002417 END 

002418 ELSE 

002419 WriteLn('Error number ',errnum,' mounting ', devname); 

002420 END; 

002421 END 

002422 END; 

002423 END { Tell PaslibPrinterLocation }; 

002424 {$ELSEC} {Spring Version} 

002425 { Paslib initialization done in the WorkShop that is not done in the DeskTop manager } 
002426 PROCEDURE Tell PaslibPrinterLocati on; 

002427 CONST 

002428 AlreadyMounted = 1052; 

002429 cdSerialCable = 32: 

002430 

002431 TYPE 

002432 TExt Words = PACKED RECORD 

002433 isPrinter: BOOLEAN; 

002434 isDefault: BOOLEAN; 

002435 driverlD: -8192..8191; 

002436 END; 

002437 

002438 VAR 

002439 errnum: INTEGER; { error return } 

002440 nextEntry: LONGI NT; 

002441 config: Confi gDev; 

002442 pExt Words: ATExt Words; 

002443 vname: E_Name; 
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002444 
002445 
002446 
002447 
002448 
002449 
002450 
002451 
002452 
002453 
002454 
002455 
002456 
002457 
002458 
002459 
002460 
002461 
002462 
002463 
002464 
002465 
002466 
002467 
002468 
002469 
002470 
002471 
002472 
002473 
002474 
002475 
002476 
002477 
002478 
002479 
002480 
002481 
002482 
002483 
002484 
002485 
002486 
002487 
002488 
002489 
002490 
002491 
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password: E_ Name; 
devControl: DcType; 

dsp: DsProcParam; 
path: Pat hname: 


BEGIN 


nextEntry := 0; 
REPEAT 
PmReadConfig(errnum, nextEntry, config); 
1F errnum <= 0 THEN 
IF config. nExtWords >= 1 THEN 
BEGIN 
pExt Words := @config. ext Words[1]; 
1F pExtWords*.isPrinter THEN 
BEGIN 
Mount(errnum, vname, password, config. devname); 


1F (errnum <= 0) or (errnum = AlreadyMounted) THEN 


BEGIN 
dsp. proccode := dsPrintDev; 


dsp. PrDevice := Concat('-', config. devname); 


DSPasli bCall (dsp); 
WITH devControl DO 


BEGIN 
path := Concat('-', config.devname, '-x 
dcversion := 2; 


dccode := 17; {auto LF disable} 
dcdata[0] := 1; 


Device Control(errnum, path, devControl); 


IF config.driverl!D = cdSerial Cable THEN 
BEGIN 
dccode := 5; 
dcdata[0] := 9600; 


Device control (errnum, path, devcontrol ); 


dccode := 2: 


Device control (errnum, path, devcontrol ); 


dccode := 1: 
dcdata[0] := 0; 


Device _control(errnum, path, devcontrol ); 


dccode := 12; 
dcdata[0] := 60; 


Device _control(errnum, path, devcontrol); 


dccode := 10; 
dcdata[0] := 0; 
dcdata[1l] := -128: 


Device control (errnum, path, devcontrol ); 
END; {IF config. driverlD = cdSerial Cable} 


END; {WITH devControl DO} 


{0D} 


{baud rate} 


{DTR} 


{8-bit no-parity} 


{time out} 


{disconnect detect} 


END {IF (errnum <= 0) or (errnum = AlreadyMounted) THEN} 
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002492 
002493 
002494 
002495 
002496 
002497 
002498 
002499 
002500 
002501 
002502 
002503 
002504 
002505 
002506 
002507 
002508 
002509 
002510 
002511 
002512 
002513 
002514 
002515 
002516 
002517 
002518 
002519 
002520 
002521 
002522 
002523 
002524 
002525 
002526 
002527 
002528 
002529 
002530 
002531 
002532 
002533 
002534 
002535 
002536 
002537 
002538 
002539 
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ELSE 
WriteLn('Error number ', errnum, ' mounting ', config. devname) ; 
END; {IF pExtWords*.isPrinter THEN} 
END; {IF config.nExt Words >= 1 THEN} 
UNTIL errnum > 0; 
END { Tell PaslibPrinterLocation }; 
{$ENDC} 


BEGIN 
Get Token; 
outfname := token; 
1F token = '' THEN 
BEGIN 
Write('Name of file to send output to? [-console] '); 
ReadLn( outf name); 
END; 
IF outfname = '' THEN 
Out putRedirect(errnum, outf name, TRUE) 
ELSE 
BEGIN 
StrUpperCased( @outf name) ; 
1F outfname = '-PRINTER' THEN 
Tell PaslibPrinterLocati on; 
Out put Redirect (errnum, out fname, FALSE); 
END; 
IF errnum > 0 THEN 
BEGIN 
IF outfname = '' THEN 
outfname := '-CONSOLE' 
WriteLn('Error number ',errnum,' redirecting output to ', outf name) 
END; 
END; 


PROCEDURE Memory Dump; 

VAR start: LONGI NT; 

numBytes: LONGI NT; 
BEGIN 

Get Token; 

IF token = '' THEN 
BEGIN 
Write('Starting address [# bytes]? '); 
Readi n(inputStr); 
Get Token; 

END; 


HexStrToLIint(@token, start, cState); 


IF cState <> cvValid THEN 
Exi t( Memory Dump) 
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002540 
002541 
002542 
002543 
002544 
002545 
002546 
002547 
002548 
002549 
002550 
002551 
002552 
002553 
002554 
002555 
002556 
002557 
002558 
002559 
002560 
002561 
002562 
002563 
002564 
002565 
002566 
002567 
002568 
002569 
002570 
002571 
002572 
002573 
002574 
002575 
002576 
002577 
002578 
002579 
002580 
002581 
002582 
002583 
002584 
002585 
002586 
002587 
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ELSE 

Get Token; 
HexStrToLint(@token, numBytes, cState); 
IF cState <> cvValid THEN 


numBytes := $10 
WrMemory(start, numBytes, TRUE) 
END; 
PROCEDURE HeapDump; 
VAR all lnfo: BOOLEAN 
wantedSTP: LONGINT; {-1 for all classes} 
all Heaps: BOOLEAN 
index: INTEGER; 
heap: THeap; 
dumpDocHeap: BOOLEAN 
BEGIN 
alll nfo := TRUE: 
wantedSTP := -1: 
all Heaps := TRUE; 
Get Token; 
IF token <> '' THEN 
BEGIN 
all Heaps := FALSE; 
Tri mBl anks( @token); 
StrUpperCased( @token); 
index := CiOfCn(Copy(Concat(token, ' '), 1, 
1F index > 0 THEN 
wantedSTP := ORD( hMySTables**.records[index]) 
ELSE 
BEGIN 


WriteLn('No such class!'); 
EXI T( HeapDump) ; 
END; 

END: 


1F all Heaps THEN 
1F NOT YesNo('AIl classes') THEN 
WHILE wantedSTP <= 0 DO 


BEGIN 
Get One(' Which class?'); 
IF token = '' THEN 
GOTO 99 
ELSE 
BEGIN 
index := Ci OfCn(token); 
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002588 1F index > 0 THEN 

002589 wantedSTP := ORD( hMySTables**. records[ index] ) 
002590 ELSE 

002591 WriteLn('No such class!'); 

002592 END; 

002593 END; 

002594 

002595 {$I1FC fDebugMet hods} 

002596 1F wantedSTP <= 0 THEN 

002597 alllnfo := YesNo('Dump fields as well as class of each object’); 
002598 {$ELSEC} 

002599 alll nfo := FALSE: 

002600 {$ENDC} 

002601 

002602 1F all Heaps THEN 

002603 1F YesNo('Dump Process Heap') THEN 

002604 DumpHeap( mainHeap, wantedSTP, 0, alllnfo); 
002605 

002606 IF istnitialized THEN 

002607 BEGIN 

002608 IF all Heaps THEN 

002609 dumpDocHeap := YesNo('Dump Active Document Heap' ) 
002610 ELSE 

002611 dumpDocHeap := TRUE; 

002612 

002613 1F dumpDocHeap THEN 

002614 BEGIN 

002615 heap := BindHeap(TRUE, TRUE) 

002616 IF heap = NIL THEN 

002617 BEGIN 

002618 WriteLn('There is no active document heap!') 
002619 WriteLn; 

002620 WriteLn; 

002621 END 

002622 ELSE 

002623 DumpHeap(heap, wantedSTP, 0, alllnfo); 
002624 END; 

002625 

002626 1F all Heaps THEN 

002627 IF YesNo(' Dump Clipboard Heap') THEN 

002628 BEGIN 

002629 heap := BindHeap( FALSE, TRUE) 

002630 1F heap = NIL THEN 

002631 BEGIN 

002632 WriteLn('There is no clipboard heap! Maybe no cut/copy has been done since booting.'); 
002633 WriteLn; 

002634 END 

002635 ELSE 
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002636 
002637 
002638 
002639 
002640 
002641 
002642 
002643 
002644 
002645 
002646 
002647 
002648 
002649 
002650 
002651 
002652 
002653 
002654 
002655 
002656 
002657 
002658 
002659 
002660 
002661 
002662 
002663 
002664 
002665 
002666 
002667 
002668 
002669 
002670 
002671 
002672 
002673 
002674 
002675 
002676 
002677 
002678 
002679 
002680 
002681 
002682 
002683 
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DumpHeap(heap, wantedSTP, 0, alllnfo) 
heap := BindHeap( FALSE, FALSE); 
END; 
END 
ELSE 
BEGIN 
WriteLn('There is no document or clipboard heap because the proces 
WriteLn; 
END; 
END; 


BEGIN {Ent Debugger } 


(* 
*) 


SetScreenKeybd(altscrn); 


traceCount := defTraceCount; 
timeToGo := FALSE: 
WriteLn; 


WriteLn('Tool Kit Debugger - ',enterReason); 


{ flush characters; because of PASLIB bug, also stop when user types a ~ } 
commented out as a test case to see if still needed here 
IF CheckKeyPress('') THEN 


IF tallyingCalls THEN 
BEGIN 
Tall yAndTi me; 
returnToMain := tallyingCalls; 
END; 


IF NOT tallyingCalls THEN 
BEGIN 
REPEAT 
1F NOT timeToGo THEN 
BEGIN 
1F showPrompt THEN 
BEGIN 
WriteLn('B)reakpoint, C)learBreakpoints [breakpoint #/ ALL] 
{$1FC fDebugMet hods} 


s is not fully initialized') 


D)ebugStatus, E)nterLisabug,'); 


WriteLn(' F)rameDump, G)o, H)eapDump [class], |)nspectObject, L)evelsToWatch,'); 


{$ELSEC} 

WriteLn(' F)rameDump, G)o, H)eapDump [class], L)evelsTo 
{$ENDC} 

WriteLn(' M)emoryDump <location> [# bytes], O)utputTo 


WriteLn(' S)tackCrawl, T)ally & Time, Watch [count] [A)ItScreen] [C)lass] [F)ields]'); 


END; 
Write('-->'); 
ReadLn(inputStr); 
END; 
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002684 
002685 
002686 
002687 
002688 
002689 
002690 
002691 
002692 
002693 
002694 
002695 
002696 
002697 
002698 
002699 
002700 
002701 
002702 
002703 
002704 
002705 
002706 
002707 
002708 
002709 
002710 
002711 
002712 
002713 
002714 
002715 
002716 
002717 
002718 
002719 
002720 
002721 
002722 
002723 
002724 
002725 
002726 
002727 
002728 
002729 
002730 
002731 


Get Token; 
IF token <> '' T 
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HEN 


CASE CharUpperCased(token[1]) OF 


null: Goki t Bug; {don't expect people to type this command, but this 
will guarantee that the Linker does not flush 
the GokitBug procedure} 

"Bi: BrSetup('Break on'); 

Cs Cl earBreaks 

'D': DebugStatus 

"EN: % GoLisabug 

‘Fi: Frame Dump; 

'G: BEGIN 
fTraceEnabled := FALSE; 
defTraceCount := 0; 
traceCount := defTraceCount; 
returnToMain := TRUE; 
timeToGo := TRUE; 
END; 

TH HeapDump; 

{$1 FC fDebugMet hods} 

eee Inspect; 

{$ENDC} 

a a Level ; 

'M: Me mor y Dump; 

‘0: ToPrinter 

"Ply Prompt OnOff; 

"R's Ref sToObj ect; 

ee StackCrawl 

Tl: BEGIN 
Tall yAndTi me; 
timeToGo := tallyingCalls; 
END; 

W: BEGIN 
TraceOrNot; 
timeToGo := TRUE; 
END; 

Xt timeToGo := TRUE; 

END; 

99: 
UNTIL timeToGo; 


END; 


IF tallyingCalls THEN 
BEGIN 
fTraceEnabled := FALSE: 
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defTraceCount := 0: 
traceCount := defTraceCount; 
returnToMain := TRUE; 

END; 


IF returnToMain THEN 
SetScreenKeybd( priscrn); 


END; {Ent Debugger} 
{$S SgCLAdbg} 


FUNCTION AKeyPress: 
VAR tb: BOOLEAN 
BEGIN 
AKeyPress := FALSE; 
1F kpcntr >= keyPresLimit THEN 
BEGIN 
tbh := KeyPress; 


BOOLEAN; 


{ force call to keyPress until press i 
1F NOT tbh THEN 
kpcentr := 0; 
AKeyPress := tb; 
END 
ELSE 
kpentr := kpentr + 1 
END; 
{ SS SSSS SS SS SSS SS S252 55222222 eee eee eee BP . EP 


{$1 FC fTrace} 
PROCEDURE BEPSN( odummy: 


LONGI NT; fBegin, displaylt: 


VAR receiver: TObj ect; 
caller: TpLONGI NT; 
i: INTEGER; 
className: TCl assName: 
procName: $8; 
toDebugger: BOOLEAN; 
next PC: LONGI NT; 


s dealt with } 


BOOLEAN) ; 


{ See if this is the method to start tracing at } 


PROCEDURE BreakHere; 


VAR ts: $16; 
i: INTEGER; 
found: BOOLEAN; 
BEGIN 
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002780 found := FALSE; 

002781 FOR i := 1 TO breakMCount DO 

002782 BEGIN 

002783 WITH breakMethods[i] DO 

002784 { NOTE: if both brClass and brMethod are '', then the iTH breakpoint is unassigned } 
002785 IF brClass = '' THEN 

002786 found := (brMethod = procName) AND (brMethod <> '') 
002787 ELSE 

002788 1F brMethod = ''' THEN 

002789 found := brClass = className 
002790 ELSE 

002791 found := (brClass = className) AND (brMethod = procName) 
002792 IF found THEN 

002793 BEGIN 

002794 displaylt := TRUE; 

002795 toDebugger := TRUE; 

002796 returnToMain := TRUE: 

002797 fTraceSelf := FALSE; 

002798 fTraceClass := TRUE; 

002799 lastBpPc := 0; 

002800 lastEpPc := 0; 

002801 EX! T( BreakHere) 

002802 END 

002803 END 

002804 END; 

002805 

002806 PROCEDURE WriteOutDebugl nfo; 

002807 CONST maxi ndent = 70 

002808 VAR i: INTEGER; 

002809 hexStr: $8; 

002810 BEGIN 

002811 WriteLn; 

002812 indentTrace := CMin(tabLevel, maxindent + 5); 
002813 

002814 IF tabLevel <= trLevMemory THEN 

002815 Write(traceLevels[tablevel]:4, ' ') 
002816 ELSE 

002817 Write(' a 

002818 

002819 Write(' ': CMin(tabLevel, maxi ndent) ) 
002820 

002821 IF tabLevel > maxindent + 5 THEN 

002822 Write(tabLevel:4, ' ') 

002823 ELSE 

002824 IF indentTrace > maxi ndent THEN 

002825 Write(' ': indentTrace - maxi ndent) 
002826 

002827 1F fBegin THEN 
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002866 
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002873 
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Write(' BEGIN ') 


ELSE 


Write('END '); 


{$IFC f 
curr XPo 
{$ENDC} 


IF clas 


DebugMet hods } 
s := indentTrace + 11 {5 for level #; 6 for BEGIN/ END}; 


sName<>'' THEN 


BEGIN 
Write(className, '.'); 


{$1 


cur 


{$E 


FC fDebugMet hods } 
rXpos := currXPos + 9; 
NDC} 


END; 


Write(p 
{$IFC f 
currXPo 
{$ENDC} 


IF (fTr 
1 F 


rocName) ; 
DebugMet hods } 
s := currXPos + 8 


aceSelf OR fTraceClass) AND (receiver <> NIL) THEN 


(procName<>' DEBUGOB)') AND (procName<>' DEBUG ') AND (procName<>' FIELDS 


(fBegin OR ((procName<>' FREEOBJE') AND (procName<>' FREE '))) THEN 


BEGIN 

{$1 FC fDebugMet hods} 
Write('('); 

currXPos := currXPos + 1; 


IF (procName <> 'FREEOBJE') AND fTraceSelf THEN 


BEGIN 
outputi ndent := currXPos 
receiver. Debug(1, ''); 
END 

ELSE 
BEGIN 


receiver. Debug(0, ''); 

Li nt ToHex(LONGINT(receiver), @hexStr); 
Write(': $', hexStr); 

END; 


Write(')'); 
{$ENDC} 
END: 


PROCEDURE TraceStuff; 
VAR nextPC: LONGI NT; 


BEGI 


N 
IF trac 


eCount = 1 THEN 
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002876 
002877 
002878 
002879 
002880 
002881 
002882 
002883 
002884 
002885 
002886 
002887 
002888 
002889 
002890 
002891 
002892 
002893 
002894 
002895 
002896 
002897 
002898 
002899 
002900 
002901 
002902 
002903 
002904 
002905 
002906 
002907 
002908 
002909 
002910 
002911 
002912 
002913 
002914 
002915 
002916 
002917 
002918 
002919 
002920 
002921 
002922 
002923 
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EntDebugger(' ','Count methods displayed') 
SE 


traceCount := traceCount - 1 
END; 


BEGIN 
toDebugger := FALSE; 


IF fDebugRecursion THEN 
EXI T( BEPSN) 
fDebugRecursion := TRUE; 


caller := TpLONGINT( odummy + 4) 
receiver := NIL; 
IF GetDollarD(TppINTEGER(caller), className, procName, nextPC) THEN 
IF (className <> '') AND (procName <> 'CREATE ') THEN 
IF Vali dObj ect(Handl e( TpLONGINT(caller*+8)%*)) THEN 
receiver := TObj ect(TpLONGI NT(caller*+8) *) 


IF breakMCount > 0 THEN 
BreakHere: 


IF displaylt THEN 
WriteOutDebugl nfo 


IF toDebugger THEN 
EntDebugger(' ','Breakpoint found' ) 
ELSE 
BEGIN 
1F displaylt THEN 
toDebugger := KeyPress 
ELSE 
toDebugger := AKeyPress 


IF toDebugger THEN 


EntDebugger(' ','Key pressed on alternate screen' ) 
ELSE 
IF (traceCount > 0) and (displaylt) THEN 

TraceStuff; 
END; 


f DebugRecursion := FALSE; 
END; 


PROCEDURE BP{(myTraceLevel: INTEGER) }; 
VAR dummy: LONGI NT; {Must be first VAR} 
bpFrame: TpLONGI NT; 
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callerPC: LONGI NT; 
departed: LONGI NT; 
N 
IF tallyingCalls THEN 
stopTime := MicroTimer(* - debugTi me*); 


tabLevel tabLevel + 1; {Increment first because BEPSN can be reentrant } 
callerPC := TpLONGINT(ORD( @dummy) + 8) *; 
IF tabLevel <= trLevMemory THEN 

BEGIN 

traceLevels[tabLevel] := myTraceLevel 

bpFrame := TpLONGI NT( ORD( @dummy) + 4); 

traceFrames[tabLevel] := Li ntAndLint(bpFrame*, $SOOFFFFFF) 

END; 


IF fTraceEnabled AND (myTraceLevel >= curTraceLevel) THEN 
BEPSN( ORD( @dummy), TRUE, TRUE) 
ELSE 
IF (breakMCount > 0) OR AKeyPress THEN 
IF callerPC <> lastBpPc THEN 
BEPSN( ORD( @dummy), TRUE, FALSE) 
lastBpPc := callerPC 


IF tallyingCalls THEN 
BEGIN 
departed := MicroTi mer; 
debugTime := debugTime + departed - stopTime + tall yOverhead; *) 
IF tabLevel <= trLevMemory THEN 
traceTimes[tabLevel] := departed (*- debugTi me*); 
END; 


PROCEDURE EP; 


BEGI 


VAR dummy: LONGI NT; {Must be first VAR and 4 bytes long} 
epFrame: LONGI NT; 
doTrace: BOOLEAN; 
i: INTEGER; 
callerPC: LONGI NT; 
elapsed: LONGI NT; 
N 


callerPC := TpLONGI NT( ORD( @dummy) + 8) %; 
IF tallyingCalls THEN 
BEGIN 
stopTime := MicroTimer (*- debugTi me*); 


IF tabLevel <= trLevMemory THEN 


Apple Lisa ToolKit 3.0 Source Code Listing -- 744 of 


1012 


002972 
002973 
002974 
002975 
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002982 
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003008 
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003012 
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003014 
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003016 
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003018 
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BEGIN 
elapsed := stopTime - traceTimes[tabLevel ]; 
FOR i := tabLevel - 1 DOWNTO 1 DO 
traceTimes[i] := traceTimes[i] + elapsed 

Tally(callerPC, elapsed); 
END 

ELSE 
BEGIN 
WriteLn('Stack bigger than performance measurement can handle! ', tablevel:1) 
tallyingCalls := FALSE; 
END; 

END; 

IF tabLevel < 0 THEN 

BEGIN 

tabLevel := 0: 

Writel n(' aaa anes edeuetet eter wuaceve le euace me etecesete '); 

BEPSN(ORD( @dummy), FALSE, TRUE); 

ABCBreak('The above EP had no BP at all', 0); 

doTrace := FALSE: 

END 

ELSE |F tabLevel <= trLevMemory THEN 
BEGIN 


epFrame := Li ntAndLint(TpLONGI NT( ORD( @dummy) + 4)%*, $OOFFFFFF); 
IF traceFrames[tabLevel] <> epFrame THEN 
BEGIN 
i := tabLevel - 1; {Try to resynchroni ze} 
WHILE (tabLevel <> i) AND (i >= 0) DO 
IF traceFrames[i] = epFrame THEN 
BEGIN 
Writel n(' aime saya? ua) eisai a Yalta arse aw psa eel rere '); 
ABCBreak('There was a BP with no EP', 0); 
tabLevel := i; 
END 
ELSE 
irsi - 
IF tabLevel <> i 
BEGIN 
Writeln(' niin hin(e, aterm, er GS. ms ceed ee, we mye ew, ee ') 
BEPSN(ORD( @dummy), FALSE, TRUE) 
ABCBreak('The above EP had no BP', 0) 
END; 


1; 
THEN 


doTrace := fTraceEnabled AND (traceLevels[tablevel] >= curTraceLevel ) 


ELSE 
doTrace := FALSE: 
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003020 
003021 
003022 
003023 
003024 
003025 
003026 
003027 
003028 
003029 
003030 
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003037 
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003042 
003043 
003044 
003045 
003046 
003047 
003048 
003049 
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003051 
003052 
003053 
003054 
003055 
003056 
003057 
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IF doTrace THEN 
BEPSN( ORD( @dummy), FALSE, TRUE) 
ELSE 


IF (breakMCount > 0) OR AKeyPress THEN 


IF callerPC <> lastEpPc THEN 


BEPSN( ORD( @dummy), FALSE, FALSE) 


IF tabLevel >= 0 THEN 
tabLevel := tabLevel - 1; 
lastEpPc := callerPC 


(* IF tallyingCalls THEN 
debugTime := MicroTimer - 
*) 


END; 


{$ENDC} 
{$ENDC} 


{$1FC fCheckHeap} 


FUNCTION CountHeap{( heap: THeap): INTEGER}; 


VAR hz: THz 
numObj ects: INTEGER 
BEGIN 
hz := THz( heap); 
IF FCheckHzOK(hz, numObjects) THEN ; 
CountHeap := numObj ects 
END; 
{$ENDC} 


{$8 slnit1} 


File -- Lines: 3057 Characters: 100113 
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FILE: "LIBTK/ UTEXT. TEXT" 


000001 UNIT UText; 

000002 {$SETC Isintrinsic := TRUE } 

000003 

000004 {$I1FC Isintrinsic} 

000005 INTRINSIC 

000006 {$ENDC} 

000007 

000008 

000009 {Multiple Paragraph Building Block for the Tool kit} 

000010 

000011 {changed 04/25/84 1437 Added TText! mage. Txtl mgForClipBoard method} 
000012 {changed 04/18/84 1652 Added firstLinePixel, useFirstPixel fields to TTextl mage} 
000013 {changed 04/16/84 1135 Added styleSheet field to TParaFor mat } 

000014 {changed 04/13/84 0209 Added TText! mage. NewEdit Para} 

000015 {changed 04/12/84 2344 Changed parameter list of TParagraph. UpdateRuns} 
000016 {changed 04/10/84 1400 Changed TEditPara.images field back to a TList} 
000017 

000018 INTERFACE 

000019 {$DECL fUseUni vText } 

000020 {$SETC fUseUnivText := TRUE} 


000021 

000022 USES 

000023 {$U libtk/ UObj ect} UObj ect, 
000024 {$IFC LibraryVersion <= 20} 

000025 {$U UFont} UFont, 
000026 {$ENDC} 

000027 {$U QuickDraw} QuickDraw 
000028 {$U libtk/ UDraw} UDraw 
000029 {$l1FC fUseUni vText} 

000030 {$U libtk/ UUni vText } UTKUni versal Text, 
000031 {$ENDC} 

000032 {$U UABC} UABC 

000033 

000034 {$DECL fTextTrace} 

000035 {$SETC fTextTrace := fDbgOK} 

000036 {$DECL fParaTrace} 

000037 {$SETC fParaTrace := fDbgOK} 

000038 {$DECL fRngText} 

000039 {$SETC fRngText := f DbgOK} 

000040 

000041 CONST 

000042 

000043 cVertMargin = 4; 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
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cHorizMargin = 6 


somethingKind = 1; 


TYPE 

TStyleChange = RECORD 
Ip: INTEGER; 
newSt yl e: TTypeStyle; 
END; 

TTxtTabDescriptor = RECORD 
xCoord: INTEGER; 
quad: TAli gnment; 
{MORE LATER} 

END; 


TDrawAction = (actionDraw, actionlnval, actionNone); 
{ PARAGRAPH SUBCLASSES } 


TParaFormat = SUBCLASS OF TObject 


dfltTStyle: TTypeStyle; {default type style} 

word Wrap: BOOLEAN 

quad: TALi gnment; 

firstI ndent: INTEGER 

leftindent: INTEGER 

right! ndent: INTEGER; 

spaceAbovePara: INTEGER 

spaceBel owPara: INTEGER 

lineSpacing: INTEGER; 

tabs: TArray; 

ref Count: INTEGER; {number of paragraphs referencing this paraFor mat} 
permanent: BOOLEAN; {TRUE -> don't free when refcount goes to zero} 
styl eSheet: TStyl eSheet; {NIL if format not in a styl eSheet} 


FUNCTION TParaFormat. CREATE(object: TObject; heap: THeap; itsStyleSheet: TStyleSheet): TParaFormat; 
{$1FC fParaTrace} 

PROCEDURE TParaFormat. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 

{$ENDC} 

PROCEDURE TParaFormat.SetTypeStyle(tStyle: TTypeStyle); 

PROCEDURE TParaFormat. ChangeRef Count By(delta: I NTEGER) 

END; 


TParagraph = SUBCLASS OF TString 
typeStyles: TArray; { of TStyleChange } 
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{Creation/ Destruction} 
FUNCTION TParagraph. CREATE(object: TObject; heap: THeap; 
initial Size: INTEGER; initialTypeStyle: TTypeStyle): TParagraph; 
PROCEDURE TParagraph. Free; OVERRI DE; 


{Debugging} 
{$IFC fParaTrace} 
PROCEDURE TParagraph. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 


{Overridden TString methods} 
PROCEDURE TParagraph. Draw(i: LONGINT; howMany: INTEGER); OVERRIDE; 
FUNCTION TParagraph. Wdth(i: LONGINT; howMany: INTEGER): INTEGER; OVERRIDE; 


{This method is used by TParagraph. Draw and TParagraph. Width to interpret the typeStyles array} 
PROCEDURE TParagraph. Drawline(startLP, endLP: INTEGER; fDraw: BOOLEAN; fWidth: BOOLEAN 
VAR width: INTEGER; VAR stylelndex: INTEGER); 


{Type Style Maintainence} 
PROCEDURE TParagraph. ChangeStyle(startLP, endLP: INTEGER; PROCEDURE Change(VAR typeStyle: TTypeStyle); 
VAR styleOfStartLP: TTypeStyle); 


{These four routines all call ChangeStyl e} 
PROCEDURE TParagraph. ChgFace(startLP, endLP: | NTEGER 
newOnFaces: {$lFC LibraryVersion <= 20}TSeteface{$ELSEC}Styl e{$ENDC}; 
VAR styleOfStartLP: TTypeStyle); 
PROCEDURE TParagraph. ChgFontSize(startLP, endLP: INTEGER; newFontSize: Byte; 
VAR styleOfStartLP: TTypeStyle); 
PROCEDURE TParagraph. ChgFontFamily(startLP, endLP: INTEGER; newFontFamily: Byte 
VAR styleOfStartLP: TTypeStyle); 
PROCEDURE TParagraph. NewStyle(startLP, endLP: | NTEGER; newTypeStyle: TTypeStyl e) 


PROCEDURE TParagraph. Cl eanRuns 
PROCEDURE TParagraph. UpdateRuns(atLP: INTEGER; replacedChars: INTEGER; insertedChars: INTEGER) 


{Character Maintainence} 
PROCEDURE TParagraph. Repl Para(fPos, numChars: INTEGER 
otherPara: TParagraph; otherFPos, otherNumChars: INTEGER); 
PROCEDURE TParagraph. Repl TString(fPos, numChars: INTEGER 
otherString: TString; otherFPos, otherNumChars: INTEGER) 
PROCEDURE TParagraph. Repl PString(fPos, numChars: INTEGER; pStr: TPString); 
{Utilities} 
{BuildExtentLRect takes an LPoint that indicates the baseline of the paragraph. It returns 
in extentLRect the bounding rectangle whose height is based on the tallest font in the 
paragraph and width is the width of the characters in the paragraph. Specifically: 
top := baseLPt.v - tallestFonti nfo. ascent 
bottom := baseLPt.v + tallestFontInfo.descent + tallestFontInfo.leading 
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left := baseLPt.h; 
right := baseLpt.h + paragraph. Width; } 
PROCEDURE TParagraph. BuildExtentLRect(baseLPt: LPoint; VAR extentLRect: LRect); 
FUNCTION TParagraph. FixLP(LP: INTEGER): INTEGER 
PROCEDURE TParagraph. SetTypeStyle(tStyle: TTypeStyle); 
PROCEDURE TParagraph. Styl eAt(Ip: INTEGER; VAR typeStyle: TTypeStyle) 


{Word Selection} 
PROCEDURE TParagraph. Fi ndWordBounds(orig: INTEGER; VAR first, last: INTEGER); 
FUNCTION TParagraph. Qualifies(pos: INTEGER): BOOLEAN 


END; 


{Editable Paragraph} 

TEditPara = SUBCLASS OF TParagraph 
{ character stuff } 

bsCount: INTEGER 

formatting stuff } 

nestLevel: INTEGER 

format: TParaFor mat; 


“on 


“o 


paral mage stuff } 
beingFiltered: BOOLEAN; { TRUE when a type style command has just been 
performed on this paragraph} 


(* 


max! mage: INTEGER; 

numl mages: INTEGER; 

i mages: ARRAY [1..1] OF TParalmage; {THIS MUST BE LAST FIELD !} 
*) 

i mages: TList; { Users may subclass TEditPara } 


{Creation/ Destruction} 
FUNCTION TEditPara. CREATE(object: TObject; heap: THeap; initialSize: INTEGER 
itsFormat: TParaFormat): TEditPara; 
PROCEDURE TEditPara. Free; OVERRIDE; 


{Debugging} 
{$1FC fParaTrace} 
PROCEDURE TEditPara.Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 


{Special Editing} 
PROCEDURE TEditPara. Begininsertion(atLP: INTEGER; size:|INTEGER); 
PROCEDURE TEdit Para. Endl nsertion; 
FUNCTION TEditPara.GrowSize: INTEGER 
PROCEDURE TEditPara.InsertOneChar(ch: CHAR; atLP: INTEGER); 
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{Utility} 
PROCEDURE TEditPara.SetTypeStyle(tStyle: TTypeStyle); OVERRI DE; 


{Paral mage Maintenance} 
PROCEDURE TEdit Para. Eachl mage( PROCEDURE | mageProc(paral mage: TParal mage) ); 
PROCEDURE TEditPara. Del! mage(dell mage: TParal mage; fFree: BOOLEAN); 
PROCEDURE TEditPara.InsI mage(paral mage: TParal mage); 
PROCEDURE TEdit Para. Del! mgl F( FUNCTION Shoul dDelete( paral mage: TParal mage): BOOLEAN) 
END; 


TLinelnfo = SUBCLASS OF TObj ect 


valid: BOOLEAN; 

startLP: INTEGER 

last DrawnLP: INTEGER; {last character in line to draw: may omit trailing spaces} 
endLP: INTEGER; {last character in line: equals next linelnfo.startLP - 1} 
lineLRect: LRect; 

lineAscent: INTEGER 


FUNCTION TLinelnfo.CREATE(object: TObject; heap: THeap): TLinelnfo 
{$1FC fParaTrace} 

PROCEDURE TLinel nfo. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 


{Used by subclassers who don't like the way the hilite/update 
rectangle is chosen so they can overrride it} 
FUNCTION TLinel nfo. LeftCoord( proposedLeft Pixel: LONGI NT): LONGI NT; 
FUNCTION TLinel nfo. RightCoord( proposedRi ght Pixel: LONGINT): LONGI NT 
END; 


TParal mage = SUBCLASS OF TI mage 


paragraph: TEdit Para; 

hei ght: | NTEGER; { pixel height of the paragraph} 

lineList: TList; { of TLinel nfo} 

changed: BOOLEAN 

tickCount: INTEGER; { incremented (mod MAXINT) every time image is drawn } 

startLP: INTEGER 

endLP: INTEGER; { while drawing, this is the LP of the beginning of the next line 
which, when drawing is finished, may be in another image if the 
paragraph is split } 

text! mage: TTextl mage; { the textl mage that this image belongs to } 

was Offset: BOOLEAN; { used by Building block to determine when to invalidate} 

{Creation} 


FUNCTION TParal mage. CREATE(object: TObject; heap: THeap; itsView: TView 
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PROCEDURE 


{Debuggi ng} 
{$lFC fPa 
PROCEDURE 
{$ENDC} 


{Routi nes} 
PROCEDURE 


FUNCTI ON 
PROCEDURE 


PROCEDURE 


PROCEDURE 
PROCEDURE 


FUNCTI ON 
PROCEDURE 
PROCEDURE 
FUNCTI ON 
PROCEDURE 
FUNCTI ON 
PROCEDURE 
FUNCTI ON 


TParal mage 


raTrace} 
TParal mage 


TParal mage. 


TParal mage. 
TParal mage. 


TParal mage. 


TParal mage. 
TParal mage. 


TParal mage. 
TParal mage. 
TParal mage. 
TParal mage. 
TParal mage. 
TParal mage. 
TParal mage. 
TParal mage. 
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itsLRect: LRect; 
LONGI NT): TParal mage; 


itsParagraph: TEdit Para; 
lineTop: LONGINT; lineLeft: 


Free; OVERRIDE; 


.Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 


ComputeLinelnfo(curLine: TLinelnfo; maxLineLen: | NTEGER 
VAR nextLP: INTEGER; VAR | RectNeeded: LRect); 
DfltLinelnfo(lineTop: LONGINT; lineLeft: LONGINT): TLinel nfo; 
Drawline(startLP: | NTEGER; fDraw: BOOLEAN 
stopWidth, wrapWidth: I NTEGER; 
VAR lineWdth, lastToDraw, endLP: INTEGER); 
DrawParal mage(limitLRect: LRect; startLP: INTEGER; drawAction 
inval Bits: BOOLEAN; VAR drawnLRect: LRect); 


TDrawActi on: 


Draw; OVERRIDE; 
FastDrawLine(startLP, endLP: INTEGER: fDraw: BOOLEAN; fWidth: 
VAR width: INTEGER; VAR stylelndex: INTEGER); 
Get Format: TParaFormat; 
LineWthLPt(pt: LPoint; VAR linelndex: 
LocateLP(LP: INTEGER; VAR linelndex: INTEGER; VAR pixel 
LpWthLPt(pt: LPoint): INTEGER 
Of fSetBy(deltaLPt: LPoint); OVERRIDE; 
ParaTextWdth(startLP, endLP: INTEGER): INTEGER 
RedrawLines(startLine: INTEGER; endLine: I NTEGER) 
SeesSameAs(image: Tl mage): BOOLEAN; OVERRI DE; 


BOOLEAN; 


INTEGER; VAR linelnfo: TLinel nfo) 
LONGI NT); 


{validation/invalidation procs} 


PROCEDURE TParal mage.I nvalLinesWth(startLP, endLP 


INTEGER) ; 


PROCEDURE TParal mage. Adj ustLineLPs(atLP, deltaLP: INTEGER); 


END; 


formats: 


{Creation} 


FUNCTION TStyleSheet. CREATE(object: TObj ect 


TList; { 


{ MULTI-PARAGRAPH SUBCLASSES } 
TStyleSheet = SUBCLASS OF TObject 


of TParaFor mat } 


heap: THeap): TStyleSheet; 


PROCEDURE TStyleSheet. Free; OVERRIDE; 


{Installs Default paraFormat into formats list} 
PROCEDURE TStyleSheet.InitDefault; 
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{Debuggi ng} 
{$1FC fParaTrace} 
PROCEDURE TStyleSheet. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 
END; 


TTextRange = SUBCLASS OF TObj ect 
firstPara: TEditPara; 
firstlndex: LONGI NT; 
firstLP: INTEGER; 
last Para: TEdit Para; 
lastIl ndex: LONGI NT; 
lastLP: INTEGER; 


{Creation} 
FUNCTION TTextRange. CREATE(object: TObject; heap: THeap; 
beginPara: TEditPara; beginlndex: LONGINT; beginLP: INTEGER 
endPara: TEditPara; endl ndex: LONGINT; endLP: INTEGER): TText Range 


{Debugging} 
{$IFC fParaTrace} 
PROCEDURE TText Range. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 


{AdjustBy adjust the fields of TTextRange by the value of delta (where delta is in LPs)} 
PROCEDURE TText Range. Adj ustBy(delta: INTEGER); 
END; 


TText = SUBCLASS OF TObject 
paragraphs: TList; {of TEditPara } 
styleSheet: TStyleSheet; 


txtIl mgList: TList; {of TTextl mages that point to this text; 
IMPORTANT: If the multiple linked textl mage feature is used as described in 
TTextl mage below, the application should only store the 
head text image in this list. This list is intended for 
textl mages that are viewing the same text object independently 
(ie in different panels) } 


{Creation/ Freeing} 
FUNCTION TText.CREATE(object: TObject; heap: THeap; itsStyleSheet: TStyleSheet): TText; 


{DfltTextl mage can be called after CREATE to create and return a single textil mage. It also 
creates one empty paragraph using the first paraFormat in SELF.styleSheet. It installs the 
textl mage in txtIlmgList and the paragraph in paragraphs. This routine calls 
textl mage. Recomputel mages to set up the first paral mage. } 

FUNCTION TText. DfltTextl mage(view: TView; imageLRect: LRect; imglsGrowable: BOOLEAN): TText! mage 
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{TText. Free frees all paragraphs that belong to this text object and all textl mages that 
reference this text object} 
PROCEDURE TText. Free; OVERRIDE; 
PROCEDURE TText. FreeSelf(freeParas: BOOLEAN); 
{Debuggi ng} 
{$IFC fParaTrace} 
PROCEDURE TText.Fields(PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 


{Calls to textl mage procs get routed through these} 
PROCEDURE TText. ChangeSel | nOtherPanel s(textSelection: TTextSelection); 
PROCEDURE TText. Del Para(del Para: TEditPara; fFree: BOOLEAN) 
PROCEDURE TText. Draw 
PROCEDURE TText. HiliteRange(highTransit: THighTransit; textRange: TTextRange; wholePara: BOOLEAN) 
PROCEDURE TText.HiliteParagraphs(highTransit: THighTransit; 
startIl ndex: LONGINT; startLP: INTEGER 
endindex: LONGINT; endLP: INTEGER; wholePara: BOOLEAN); 
PROCEDURE TText.InsParaAfter(existingPara: TEditPara; mewPara: TEditPara); 
PROCEDURE TText.Invalidate 
PROCEDURE TText. MarkChanged(textRange: TTextRange) 
PROCEDURE TText. Recomputel mages 
FUNCTION TText. SelectAll (textl mage: TTextl mage): TTextSel ection; 
END; 


TTextl mage = SUBCLASS OF TI mage 


text: TText; {complete list of paragraphs} 

imageList: TList; {paralmages for some range of paragraphs in text} 

tickCount: INTEGER 

grows Dynami cally: BOOLEAN; {TRUE --> extentLRect bottom grows as more text entered 
FALSE -> text is truncated at last line that fits} 

mi nHei ght: | NTEGER; {the minimum height to shrink (if growsDynami call y=TRUE) 
defaults to height of original extentLRect} 

former Bottom: LONGI NT; {Used by Invalidate when the displayed paragraphs get shorter 
and text at end needs to be erased} 

updateLRect: LRect; { " " " "} 

firstLinePixel: LONGI NT; {Used by Text BB to limit what gets erased on first update line} 

useFirstPixel: BOOLEAN 


{ The following fields support multiple linked text images displaying a single text object 
where the text "flows" from one box to the next. APPLICATIONS ARE RESPONSIBLE FOR 
MAINTAINING THESE FIELDS. This Building Block uses these fields for drawing, etc. 

All text images in a chain should have growsDynamically set to FALSE (except possibly 
for the last text image in a chain) 
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For applications that DO NOT use this feature, the fields will always be as follows: 
startLP = 0; 
endLP = LP of last character in last paragraph; (if growsDynamically = TRUE) 
LP of last character that fit in extentLRect; (if growsDynamically = FALSE) 
prevTxtl mg, nextTxtl mg = NIL; 


headTxtI mg = SELF; 
tail Txtlmg = SELF; 
} 
firstindex: LONGI NT; {index of paragraph at SELF.imageList. First} 
startLP: | NTEGER; {startLP of paragraph at SELF.imageList. First} 
endLP: | NTEGER; {endLP of paragraph at SELF.imageList. Last} 
prevTxtl mg: TTextl mage; { for linking textIl mages that display different parts of } 
next Txtl mg: TTextIl mage; { the same text object. eg: columns} 
headTxtI mg: TTextl mage; {points to first text image in this list} 
tail Txt mg: TTextl mage; {points to last text image in this list} 
{Creation} 


FUNCTION TTextI mage. CREATE(object: TObject; heap: THeap; itsView: TView 
itsLRect: LRect; itsText: TText; isGrowable: BOOLEAN): TTextl mage 


{TTextl mage. Free frees all text images and their paralmages in the text image chain. 

It does NOT free any paragraphs, text objects, or paraFormats. Call this only once 

for each text image chain (NOT for each text image in the chain). Note that TText. Free 
frees its textl mages so calling this routine is not necessary in most cases} 

PROCEDURE TText! mage. Free; OVERRI DE; 


{TTextl mage. FreeOneText! mage frees just one text image fromthe chain. It pays no attention 
to links or whether this is the head text image. Maintenance of these fields must be 
handled by the caller before calling this routine. Those who do not use linked text images 
should always call TTextIl mage. Free above, NOT this routine} 

PROCEDURE TTextl mage. FreeOneTextl mage 


{Debugging} 
{$IFC fParaTrace} 
PROCEDURE TTextl mage. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 


{Drawi ng} 
PROCEDURE TTextI mage. Draw; OVERRIDE; 
PROCEDURE TTextl mage. Drawl mages(f Draw: BOOLEAN) 
PROCEDURE TTextl mage. DrawOrl nval(inval Bits: BOOLEAN); 
PROCEDURE TTextl mage. HiliteText(highTransit: THighTransit; 
startl ndex: LONGINT; startLP: | NTEGER: 
endindex: LONGINT; endLP: INTEGER; wholePara: BOOLEAN); 


{Locating} 
PROCEDURE TTextI mage. FindParaAndLp(LPt: LPoint; VAR paral mage: TParal mage 
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FUNCTION TTextl mage 
FUNCTION TTextl mage 


PROCEDURE TTextl mage. 


FUNCTION TTextl mage. 
PROCEDURE TTextl mage. 
PROCEDURE TTextl mage. 


{| mage maintenence} 


PROCEDURE TTextl mage. 
PROCEDURE TTextl mage. 
PROCEDURE TTextl mage. 
PROCEDURE TTextl mage. 
PROCEDURE TTextl mage. 
PROCEDURE TTextl mage. 


FUNCTION TTextl mage. 
PROCEDURE TTextl mage. 


PROCEDURE TTextl mage. 
FUNCTION TTextl mage. 


{By default SetFirstin 
if they want the disp 
PROCEDURE TTextl mage 


{These routines are 
then override these 
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VAR paral ndex: LONGINT; VAR aLP: INTEGER); 

.FindText!mage(VAR mouseLPt: LPoint; VAR firstTxtlmg: TText!l mage): TTextl mage 
.TmageBottom LONGI NT; 
Get| mageRange(firstindex: LONGINT; VAR firstLP: INTEGER 

lastIl ndex: LONGINT; VAR lastLP: INTEGER 

VAR firstl mage, lastl mage: TParal mage); 
ImageWith(paragraph: TEditPara; Ip: INTEGER): TParal mage 
MousePress(mouseLPt: LPoint); OVERRIDE; 
OffsetBy(deltaLPt: LPoint); OVERRIDE; 


Addl mage(paral mage: TParal mage); 
Dell magesWith(del Para: TEditPara) 
InsertNewPara(existingPara, newPara: TEditPara) 
Inval All; 
Invalidate; OVERRIDE; {Invalidate changed lineLRects in changed parai mages} 
MarkChanged(startIindex: LONGINT; startLP: INTEGER 
endindex: LONGINT; endLP: INTEGER); 
NewTextSelection(firstPara: TEditPara; firstIindex: LONGINT; firstLP: INTEGER 
lastPara: TEditPara; lastIl ndex: LONGINT; I|astLP: INTEGER 
): TTextSel ection: 
Recomputel mages(drawAction: TDrawAction; inval Bits: BOOLEAN) 
Resize(newExtent: LRect); OVERRIDE; 
SeesSameAs(image: Tl mage): BOOLEAN; OVERRI DE; 


dex just sets firstlndex to 0, but subclassers may override this 
lay to start from other than the first paragraph} 
,SetFirstindex; 


provided so that users can subclass the appropriate class and 
methods so that the building block will create the user's subclass 


when generating new instances of that class. } 


FUNCTION TTextl mage 
FUNCTION TTextl mage 


FUNCTION TTextl mage 
FUNCTION TTextl mage 
END; 


{Clipboard Text View} 
TText View = SUBCLASS OF 


textl mage: TTextl ma 
valid: BOOLEAN; 
{Creation} 


Apple Li 


-NewEditPara(initial Size: INTEGER; itsFormat: TParaFormat): TEditPara:; 
.NewParal mage(itsParagraph: TEditPara; itsLRect: LRect; 
lineTop: LONGINT; lineLeft: LONGINT): TParal mage 
.NewTextl mage(heap: THeap; itsView: TView; itsLRect: LRect; 
itsText:TText; isGrowable: BOOLEAN): TTextl mage 
.Txtl mgForClipBoard( heap: THeap; itsView: TView; itsLRect: LRect; 
itsText:TText; isGrowable: BOOLEAN): TTextl mage 


TView 
ge; 
{lf FALSE, calls Recompute before Drawing} 
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000476 FUNCTION TTextView. CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itsExtent: LRect) 
000477 : TText View 

000478 

000479 {Debuggi ng} 

000480 {$I FC fParaTrace} 

000481 PROCEDURE TText View. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
000482 {$ENDC} 

000483 

000484 {$I FC fUseUni vText } 

000485 PROCEDURE TText View. CreateUni versal Text; OVERRI DE; 

000486 {$ENDC} 

000487 PROCEDURE TText View. Draw; OVERRIDE; 

000488 PROCEDURE TText View. MousePress(mouseLPt: LPoint); OVERRIDE; 

000489 END; 

000490 

000491 

000492 {$1 FC fUseUni vText} 

000493 TTextWriteUnivText = SUBCLASS OF TTKWriteUnivText 

000494 textSelection: TTextSel ection; 

000495 currl ndex: LONGI NT; 

000496 currPara: TEdit Para: 

000497 currLP: INTEGER; 

000498 currStylelndex: INTEGER 

000499 currTStyles: TArray; 

000500 {Creation} 

000501 FUNCTION TTextWriteUnivText. CREATE(object: TObject; heap: THeap; 

000502 itsString: TString; itsDataSize: INTEGER 
000503 itsTextSel: TTextSelection): TTextWriteUnivText; 
000504 

000505 {Debugging} 

000506 {$I FC fParaTrace} 

000507 PROCEDURE TText WriteUnivText. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
000508 {$ENDC} 

000509 

000510 PROCEDURE TText WriteUnivText. Fill Paragraph; OVERRI DE; 

000511 END; 

000512 {$ENDC} 

000513 

000514 

000515 TTextSelection = SUBCLASS OF TSelection 

000516 text! mage: TTextl mage; 

000517 text Range: TText Range; 

000518 isWordSel ection: BOOLEAN 

000519 isParaSel ection: BOOLEAN 

000520 vi ewTi ck: INTEGER; 

000521 amTy ping: BOOLEAN 

000522 currTypeStyle: TTypeStyle; 

000523 
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000524 FUNCTION TTextSelection. CREATE(object: TObject; heap: THeap; itsView: TView 

000525 itsTextl mage: TTextl mage; itsAnchorLPt: LPoint; 

000526 beginPara: TEditPara; beginlndex: LONGINT; beginLP: INTEGER 
000527 endPara: TEditPara; endindex: LONGINT; endLP: INTEGER 
000528 ): TTextSel ection; 

000529 

000530 

000531 {Debuggi ng} 

000532 {$I FC fParaTrace} 

000533 PROCEDURE TTextSelection. Fields(PROCEDURE Field(nameAndType: $255)); OVERRIDE; 

000534 {$ENDC} 

000535 

000536 {Commands } 

000537 PROCEDURE TTextSel ection. KeyText 

000538 FUNCTION TTextSelection. NewCommand(cmdNumber: TCmdNumber): TCommand; OVERRI DE; 

000539 FUNCTION TTextSelection. NewStyleCmd( heap: THeap; cmdNumber: TCmdNumber 

000540 textl mage: TTextl mage): TCommand 

000541 FUNCTION TTextSelection. NewCutCopyCmd( heap: THeap; cmdNumber: TCmdNumber; 

000542 textl mage: TTextl mage): TCommand; DEFAULT; 

000543 PROCEDURE TTextSelection. StyleFromContext; DEFAULT; 

000544 PROCEDURE TTextSelection. DoChangeStyle(cmdNumber: TCmdNumber; paragraph: TParagraph; 
000545 firstLP: INTEGER; lastLP: INTEGER; VAR newStyle: TTypeStyle) 
000546 PROCEDURE TTextSelection. ChangeStyle(cmdNumber: TCmdNumber); DEFAULT; 

000547 {Editing} 

000548 PROCEDURE TTextSel ection. ChangeText( PROCEDURE TextEdit; PROCEDURE Adjust); DEFAULT; 

000549 FUNCTION TTextSelection. CopySelf(heap: THeap; view: TView): TMultiParaSelection; DEFAULT; 
000550 PROCEDURE TTextSelection. CutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN); DEFAULT; 
000551 PROCEDURE TTextSelection. DeleteAndFree; DEFAULT; 

000552 FUNCTION TTextSelection. DeleteButSave: TText; DEFAULT; 

000553 

000554 {Hi ghl i ghting} 

000555 PROCEDURE TTextSelection. Highlight(highTransit: THighTransit); OVERRIDE; 

000556 

000557 {Selecting} 

000558 FUNCTION TTextSelection. Becomel nsertionPoint: TlnsertionPoi nt; 

000559 PROCEDURE TTextSelection. GetHysteresis(VAR hysterPt: Point); OVERRIDE; 

000560 PROCEDURE TTextSelection. MousePress(mouseLPt: LPoint); OVERRIDE; 

000561 FUNCTION TTextSelection. SelSize: INTEGER; ABSTRACT; 

000562 

000563 {I nvali dation} 

000564 PROCEDURE TTextSelection.Invalidate; DEFAULT 

000565 

000566 {Generate Text Selection in another panel (ie. another Text | mage) } 

000567 FUNCTION TTextSelection. ReplicateForOtherPanel (itsTextl mage: TTextl mage): TTextSel ection; 
000568 END; 

000569 

000570 

000571 Tl nsertionPoint = SUBCLASS OF TTextSelection 


Apple Lisa ToolKit 3.0 Source Code Listing -- 758 of 1012 


000572 
000573 
000574 
000575 
000576 
000577 
000578 
000579 
000580 
000581 
000582 
000583 
000584 
000585 
000586 
000587 
000588 
000589 
000590 
000591 
000592 
000593 
000594 
000595 
000596 
000597 
000598 
000599 
000600 
000601 
000602 
000603 
000604 
000605 
000606 
000607 
000608 
000609 
000610 
000611 
000612 
000613 
000614 
000615 
000616 
000617 
000618 
000619 


Apple Lisa 


Computer Technical Information 


typi ngCmd: TTy pi ngCmd; {the current typing command (if user is typing) } 
styl eCmdNumber: | NTEGER; {Set to cmdNumber when a type style itemis chosen, 
set to zero otherwise} 

newest LP: | NTEGER; {the Ip position as updated between KeyPause's} 
just Returned: BOOLEAN; {flag that prevents redundant update in KeyPause} 
nextHighTransit: THi ghTransit 
nextTransitTi me: LONGI NT; 

{Creati on/ Freeing} 


FUNCTION TinsertionPoint.CREATE(object: TObject; heap: THeap; 


{Debuggi ng} 
{$lFC fPa 
PROCEDURE 
{$ENDC} 


{Commands } 
PROCEDURE 
PROCEDURE 
PROCEDURE 
FUNCTI ON 


PROCEDURE 


{Editing} 
PROCEDURE 
PROCEDURE 
PROCEDURE 


PROCEDURE 
PROCEDURE 
PROCEDURE 
PROCEDURE 


{Selecting} 
PROCEDURE 
PROCEDURE 
PROCEDURE 


END; 
TOneParaSel ec 


anchor Beg 
anchorEnd 


raTrace} 


Tl nsertionPoint. 


Tl nsertionPoint. 
Tl nsertionPoint. 
Tl nsertionPoint. 
Tl nsertionPoint. 


Tl nsertionPoint. 


Tl nsertionPoint. 
Tl nsertionPoint. 
Tl nsertionPoint. 


Tl nsertionPoint. 
Tl nsertionPoint. 
Tl nsertionPoint. 
Tl nsertionPoint. 


Tl nsertionPoint. 
Tl nsertionPoint. 
Tl nsertionPoint. 


tion = 
in: INTEGER; 
: INTEGER; 
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itsView: TView 
itsTextl mage: TTextl mage; itsAnchorLPt: LPoint; itsParagraph: 
itsIndex: LONGI NT; itsLP: INTEGER): Ti nsertionPoint; 


TEdit Para; 


Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 


IdleBegin(centiSeconds: LONGINT); OVERRI DE; 
IdleContinue(centiSeconds: LONGINT); OVERRI DE; 
IdleEnd(centiSeconds: LONGI NT); OVERRI DE; 
NewCutCopyCmd(heap: THeap; cmdNumber: TCmdNumber 

textl mage: TTextl mage): TCommand; OVERRIDE; 
StyleFromContext; OVERRI DE; 


CutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN); 

FinishPaste(clipSelection: TSelection; pic: PicHandle); 

InsertText(text: TText; isParaSelection: BOOLEAN; isWordSelection: BOOLEAN 
universal Text: BOOLEAN) 


OVERRI DE; 


KeyBack(f Word: BOOLEAN); OVERRIDE; 
KeyChar(ch: CHAR); OVERRIDE; 
KeyClear; OVERRI DE; 

KeyForward(fWord: BOOLEAN); OVERRI DE; 


MouseMove(mouseLPt: LPoint); OVERRIDE; 
MousePress(mouseLPt: LPoint); OVERRIDE; 
MouseRel ease; OVERRI DE; 


SUBCLASS OF TTextSelection 


{anchorBegin <> anchorEnd iff double or triple click} 
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000666 
000667 
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{Creation/ Freeing} 
FUNCTION TOneParaSelection. CREATE(object: TObject; heap: THeap; itsView: TView 
itsTextl mage: TTextl mage; itsAnchorLPt: LPoint; itsParagraph: TEditPara; 
itsIndex: LONGINT; ol dLP: INTEGER; currLP: INTEGER): TOneParaSel ection; 


{Debuggi ng} 
{$IFC fParaTrace} 
PROCEDURE TOneParaSel ection. Fields( PROCEDURE Field(nameAndType: $255)); OVERRI DE; 
{$ENDC} 


{Commands } 
PROCEDURE TOneParaSel ection. StyleFromContext; OVERRI DE; 


{Editing} 
FUNCTION TOneParaSelection. CopySelf(heap: THeap; view: TView): TMultiParaSelection; OVERRIDE; 
PROCEDURE TOneParaSel ection. Del eteAndFree; OVERRIDE; 
FUNCTION TOneParaSel ection. DeleteButSave: TText; OVERRIDE; 


{Selecting} 
PROCEDURE TOneParaSel ection. MouseMove(mouseLPt: LPoint); OVERRIDE; 
PROCEDURE TOneParaSel ection. MouseRelease; OVERRI DE; 


END; 


TMul tiParaSelection = SUBCLASS OF TTextSelection 


anchorPara: TEdit Para; 

anchorl ndex: LONGI NT; 

anchor Begin: INTEGER; 

anchorEnd: INTEGER; {anchorBegin <> anchorEnd iff double or triple click} 


{Creation/ Freeing} 
FUNCTION TMultiParaSelection. CREATE(object: TObject; heap: THeap; itsView: TView 
itsTextl mage: TTextl mage; itsAnchorLPt: LPoint; 
beginPara: TEditPara; beginlndex: LONGINT; beginLP: INTEGER 
endPara: TEditPara; endindex: LONGI NT; endLP: INTEGER 
beginlsAnchor: BOOLEAN): TMultiParaSel ection; 


{Debugging} 
{$IFC fParaTrace} 
PROCEDURE TMulti ParaSel ection. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 


{Commands } 
PROCEDURE TMulti ParaSelection. StyleFromContext; OVERRI DE; 


{Editing} 
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FUNCTION TMultiParaSelection. CopySelf(heap: THeap; view: TView): TMultiParaSelection; OVERRI DE; 
FUNCTION TMultiParaSelection. Delete(savelt: BOOLEAN): TText; 

PROCEDURE TMulti ParaSel ection. DeleteAndFree; OVERRI DE; 

FUNCTION TMultiParaSelection. DeleteButSave: TText; OVERRIDE; 


{Selecting} 
PROCEDURE TMulti ParaSel ection. MouseMove( mouseLPt: LPoint); OVERRIDE; 
PROCEDURE TMulti ParaSel ection. MouseRelease; OVERRIDE: 


END; 


fio: cnis. vinldeti ate COMMANDS -----+--+--++eeeeeee } 


TClearTextCmd = SUBCLASS OF TCommand 


{Variables} 
savedText: TText; {save the cleared text for undo} 
text: TText; {the text object we are clearing} 
{Creation} 


FUNCTION {TClearTextCmd. }CREATE( object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itslmage: Tlmage; itsText: TText): TClearTextCmd 


PROCEDURE TClearTextCmd. Free; OVERRIDE; 
{$IFC fParaTrace} 
PROCEDURE TClearTextCmd. Fields( PROCEDURE Field(nameAndType: S$255)); OVERRIDE; 
{$ENDC} 
{Command Execution} 
PROCEDURE TClearTextCmd. Commit; OVERRIDE; 
PROCEDURE TClearTextCmd. Perform(cmdPhase: TCmdPhase); OVERRIDE; 
END; 


TStyleCmd = SUBCLASS OF TCommand 


{Variables} 
text: TText; 
textSel ection: TTextSel ection; 


firstFiltParalndex: LONGI NT; 
lastFiltParalndex: LONGINT; 


filtFirstLP: INTEGER 

filtLastLP: INTEGER 

currFilteredPara: TEdi t Para; {handle to most recently filtered paragraph} 

filteredStyles: TArray; {changed type styles of most recently filtered paragraph} 
{Creation} 


FUNCTION TStyleCmd. CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itsl mage: Tl mage 
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itsFirstIl ndex: LONGINT; itsLastIlndex: LONGI NT; 
itsLPFirst: INTEGER; itsLPLast: INTEGER 
itsSelection: TTextSelection): TStyleCmd; 


PROCEDURE TStyleCmd. Free; OVERRIDE; 
{$IFC fParaTrace} 
PROCEDURE TStyleCmd. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 
{Command Execution} 
PROCEDURE TStyleCmd. Commit; OVERRIDE; 
PROCEDURE TStyleCmd. FilterAndDo(actual Object: TObj ect; 
PROCEDURE DoToObject(filteredObject: TObject)); OVERRIDE; 
PROCEDURE TStyleCmd. Perform(cmdPhase: TCmdPhase); OVERRI DE; 
END; 


TTextCutCopy = SUBCLASS OF TCutCopyCommand 


{Variables} 
text: TText; 


{Creation} 
FUNCTION TTextCutCopy. CREATE( object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itsl mage: TI mage; 
isCutCmd: BOOLEAN; itsText: TText): TTextCutCopy; 


PROCEDURE TTextCutCopy. Free; OVERRI DE; 
{$IFC fParaTrace} 
PROCEDURE TTextCutCopy. Fields( PROCEDURE Field(nameAndType: S255)); OVERRIDE; 
{$ENDC} 
{Command Execution} 
PROCEDURE TTextCutCopy. DoCutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN 
cmdPhase: TCmdPhase); OVERRIDE; 
END; 


TTextPaste = SUBCLASS OF TPasteCommand 


{Variables} 
savedText: TText; 
pasteRange: TText Range; {The text range spanned by the pasted text} 
text: TText; 


origlsPara: BOOLEAN 
origlsWord: BOOLEAN 
cliplsPara: BOOLEAN 


{Creation} 


FUNCTION TTextPaste. CREATE( object: TObject; heap: THeap; itslmage: Tl mage 
itsText: TText): TTextPaste; 
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PROCEDURE TTextPaste. Free; OVERRI DE; 
{$IFC fParaTrace} 
PROCEDURE TText Paste. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 
{Command Execution} 
PROCEDURE TText Paste. Commit; OVERRIDE; 
PROCEDURE TTextPaste. DoPaste(clipSelection: TSelection; pic: PicHandle; cmdPhase: TCmdPhase); 


OVERRI DE: 
END; 
TTypingCmd = SUBCLASS OF TCommand 

{Variables} 
savedText: TText; 
text: TText; 
newCharCount: INTEGER; 
newParaCount: INTEGER 
typi ngRange: TText Range; {The text range spanned by the typed characters} 
otherlnsPts: TList; 

{Creation} 


FUNCTION TTypingCmd. CREATE(object: TObject; heap: THeap; itsl mage: TI mage 
itsText: TText): TTypingCmd; 


PROCEDURE TTypingCmd. Free; OVERRI DE; 
{$1FC fParaTrace} 
PROCEDURE TTypingCmd. Fields( PROCEDURE Field(nameAndType: $255)); OVERRIDE; 
{$ENDC} 
{Command Execution} 
PROCEDURE TTypingCmd. Commit; OVERRIDE; 
PROCEDURE TTypingCmd. Perform(cmdPhase: TCmdPhase); OVERRIDE; 


END; 
VAR fParaTrace: BOOLEAN 
fTextTrace: BOOLEAN; 


| MPLEMENTATI ON 


* 
$l UTEXT2.text} {Paragraph classes} 

$l UTEXT3. text} {TStyleSheet, TText, TTextl mage, TText Vi ew} 
$1 UTEXT4.text} {Text Selections and Commands} 

) 


ee ee 


{$l LibTK/ UTEXT2.text} {Paragraph classes} 
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000814 
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End of 


{$1 


File -- 
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Li bTK/ UTEXT3.text} {TStyleSheet, TText, TTextl mage, TTextVi ew} 
{$l LibTK/ UTEXT4. text} {Text Selections and Commands} 
END. 


Lines: 


815 Characters: 35994 


Apple Lisa ToolKit 3.0 Source Code Listing 


764 of 1012 


Apple Lisa Computer Technical Information 


000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


{UText 2} 


{changed 
{changed 
{changed 
{changed 


{changed 
{changed 


{changed 
{changed 
{changed 
{changed 
{changed 
{changed 
{changed 


D+} 


{Para 


05/11/84 
04/25/84 
04/18/84 
04/17/84 


04/ 16/84 
04/ 16/ 84 


04/13/84 
04/13/84 
04/12/84 
04/11/84 
04/11/84 
04/10/84 
04/10/84 


FC f RngABC} 


graph 


1135 
1250 
1652 
1806 


1135 
1033 


1739 
1537 
2344 
1527 
1454 
1400 
1158 


Classes} 


Added TParagraph. Cl one} 

Changed FilterAndDo calls back to filtering TParal mage for Compugraphic} 

Use TTextl mage. firstLinePixel in DrawParal mage} 

Put call to ReplTString outside of IF in Repl Para; 

Put more parameter checks in Repl TString} 

Added styleSheet field to TParaFormat; use it in ChangeRef Count By} 

Put PicTextBegin, End in TParagraph. DrawLine 

Put PicGrpBegin, End in TParal mage. RedrawLi nes 

Removed picture comments from TParal mage. DrawLi ne} 

Set paraformat.refcount = 0 in TParaFormat. Clone} 

Changed calls to FilterAndDo to pass TEditPara rather than TParal mage} 
Modified UpdateRuns to use new parameter list} 

Call UpdateRuns after deleting characters in TParagraph. Repl PString and Repl TString} 
Debug statement in Qualifies to check bug involving special characters} 
Changed TEditPara.images field back to a TList and adusted references to it} 
Put calls to TParaFormat. ChangeRefCountBy in TEditPara. CREATE, Free} 


TScanState = (cBeforeRange, clnRange, cAfterRange); 

PACKED ARRAY[1..SIZEOF(TTypeStyle)] OF CHAR 
{$1 FC LibraryVersion <= 20} 

Style = TSeteface 
FontI nfo = TFinfo 
{$ENDC} 


TFakeTStyle 


{$$ SgTxt Hot} 


VAR next Hi ghTransit: 


THi ghTransit; 
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000044 nextTransitTi me: LONGI NT; 

000045 uvFont: ARRAY [1..14] OF TFontRecord 
000046 

000047 

000048 METHODS OF TParaFormat 

000049 

000050 {$8 SgTxtI ni} 

000051 FUNCTION TParaFormat. CREATE(object: TObject; heap: THeap; itsStyleSheet: TStyleSheet): TParaFor mat 
000052 VAR tabArray: TArray; 

000053 BEGIN 

000054 {$I1FC fTrace}BP(6); {$ENDC} 

000055 IF object = NIL THEN 

000056 object := NewObject(heap, THISCLASS) 
000057 SELF := TParaFormat(obj ect); 

000058 tabArray := TArray. CREATE(NIL, heap, 0, SI ZEOF(TTxtTabDescri ptor)) 
000059 WITH SELF DO 

000060 BEGIN 

000061 {$H- } 

000062 MakeTypeStyle(famModern, sizel2Pitch, [], dfltTstyle) 
000063 {$H+} 

000064 wordWrap := TRUE; 

000065 quad := aLeft; 

000066 firstlndent := 0; 

000067 leftindent := 0: 

000068 rightIndent := 0; 

000069 spaceAbovePara := 0; 

000070 spaceBelowPara := 0; 

000071 lineSpacing := 0; 

000072 tabs := tabArray; 

000073 permanent := FALSE; 

000074 refCount := 0; 

000075 styleSheet := itsStyl eSheet; 

000076 END; 

000077 {$I1FC fTrace}EP; {$ENDC} 

000078 END; 

000079 

000080 {$8 SgTxtCld} 

000081 PROCEDURE TParaFormat. Free 

000082 BEGIN 

000083 {$1FC fTrace}BP(10); {$ENDC} 

000084 Free(SELF.tabs); 

000085 SUPERSELF. Free 

000086 {$1FC fTrace}EP; {$ENDC} 

000087 END; 

000088 

000089 

000090 {$8 SgTxtCld} 

000091 FUNCTION TParaFormat.Clone(heap: THeap): TObj ect 
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000092 VAR tabs: TArray; 

000093 paraFormat: TParaFormat; 

000094 BEGIN 

000095 {$1 FC fTrace}BP( 10); {$ENDC} 

000096 tabs := TArray(SELF. tabs. Cl one( heap) ) 
000097 paraFormat := TParaFormat(SUPERSELF. Cl one( heap) ) 
000098 paraFormat.tabs := tabs 

000099 paraFormat.refCount := 0; 

000100 Clone := paraFormat; 

000101 {$I1FC fTrace}EP; {$ENDC} 

000102 END; 

000103 

000104 


000105 {$8 SgTxtCld} 
000106 {$IlFC fParaTrace} 


000107 PROCEDURE TParaFormat. Fields( PROCEDURE Field(nameAndType: $255)) 
000108 BEGIN 

000109 SUPERSELF. Fi el ds( Fi el d) 

000110 Field('dfltTstyle: RECORD onFaces: HexByte; filler: HexByte; fontFamily: Byte; fontSize: Byte END'); 
000111 Field('wordWrap: BOOLEAN' ); 

000112 Field('quad: HexByte'); 

000113 Field('firstindent: INTEGER’) 

000114 Field('leftindent: INTEGER'); 

000115 Field('rightIndent: INTEGER’) 

000116 Field('spaceAbovePara: INTEGER' ); 

000117 Field('spaceBel owPara: INTEGER' ); 

000118 Field('lineSpacing: INTEGER’) 

000119 Field('tabs: TArray') 

000120 Field('refCount: | NTEGER'); 

000121 Field(' permanent: BOOLEAN’ ) 

000122 Field('styleSheet: BOOLEAN'); 

000123 Field(''); 

000124 END; 

000125 {$ENDC} 

000126 

000127 

000128 {$8 SgTxtCld} 

000129 PROCEDURE TParaFormat. ChangeRef Count By(delta: INTEGER); 
000130 BEGIN 

000131 {$I1FC fTrace}BP( 10); {$ENDC} 

000132 SELF.refCount := SELF.refCount + delta; 

000133 IF (SELF.refCount <= 0) AND NOT SELF. permanent THEN 
000134 BEGIN 

000135 |F SELF.styleSheet <> NIL THEN 

000136 SELF. styl eSheet. formats. Del Object(SELF, TRUE) 
000137 ELSE 

000138 SELF. Free; 

000139 END; 
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{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TParaFormat.SetTypeStyle(tStyle: TTypeStyle); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SetQDTypeStyle(tStyle); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtI ni} 

BEGIN 
UnitAuthor('Apple'); 

END; 


METHODS OF TParagraph; 


{$$ SgTxtI ni} 
FUNCTION TParagraph. CREATE( object: TObj ect 


initial Size: 


heap: THeap; 
INTEGER; 
VAR ts: 

styl eChange: 
BEGIN 

{$1FC fTrace}BP( 10); {$ENDC} 

IF object = NIL THEN 
object := NewDynObject( heap, THISCLASS, initial Size); 
:= TParagraph(TString. CREATE(object, heap, initialSize)); 


TArray; 
TStyl eChange; 


SELF 


ts := TArray.CREATE(NIL, heap, 0, SIZEOF(TStyl eChange) ); 
styleChange.|p := MAXINT; { -sentinel- } 

styl eChange. newStyle := initial TypeStyle; 

ts. I nsAt(1, @styl eChange) 

styleChange.Ip := -1; 

ts. I nsAt(1, @styl eChange) 


SELF.typeStyles := ts; 
{$IFC fTrace}EP; {$ENDC} 
END; 
{$S SgTxtCld} 
PROCEDURE TParagraph. Free 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
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initialTypeStyle: 


TTypeStyle): TParagraph; 


768 of 1012 


Apple Lisa Computer Technical Information 


000188 Free(SELF.typeStyl es) 

000189 SUPERSELF. Free 

000190 {$I FC fTrace}EP; {$ENDC} 

000191 END; 

000192 

000193 

000194 {$8 SgTxtCld} 

000195 FUNCTION TParagraph. Clone(heap: THeap): TObject; 
000196 VAR paragraph: TParagraph; 

000197 styles: TArray; 

000198 BEGIN 

000199 {$1 FC fTrace}BP( 10); {$ENDC} 

000200 styles := TArray(SELF.typeStyles. Cl one( heap) ); 
000201 paragraph := TParagraph( SUPERSELF. Cl one( heap) ) 
000202 paragraph, typeStyles := styles 

000203 Clone := paragraph; 

000204 {$I1FC fTrace}EP; {$ENDC} 

000205 END; 

000206 

000207 


000208 {$8 SgTxtCld} 
000209 {$IFC fParaTrace} 


000210 PROCEDURE TParagraph. Fields( PROCEDURE Field(nameAndType: $255)) 

000211 BEGIN 

000212 SUPERSELF. Fields( Field) 

000213 Field(CONCAT('typeStyles: TArray OF RECORD Ip: INTEGER; onFaces: HexByte; ', 

000214 ‘filler: HexByte; fontFamily: Byte; fontSize: Byte END')); 
000215 Field(''); 

000216 END; 

000217 {$ENDC} 

000218 

000219 


000220 {$8 TK2Start} 
000221 {BuildExtentLRect takes an LPoint that indicates the baseline of the paragraph. It returns 


000222 in extentLRect the bounding rectangle whose height is based on the tallest font in the 
000223 paragraph and width is the width of the characters in the paragraph. } 

000224 PROCEDURE TParagraph. BuildExtentLRect(baseLPt: LPoint; VAR extentLRect: LRect); 
000225 VAR styl eChange: TStyl eChange 

000226 fl nfo: Fontl nfo; 

000227 1: | NTEGER; 

000228 tallestFont: Fontl nf 0; 

000229 wi dt h: INTEGER 

000230 oldTallest: INTEGER 

000231 BEGIN 

000232 {$1FC fTrace}BP( 10); {$ENDC} 

000233 oldTallest := 0: 

000234 FOR i := 1 to SELF.typeStyles.size - 1 DO 

000235 BEGIN 
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000236 
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000241 
000242 
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000248 
000249 
000250 
000251 
000252 
000253 
000254 
000255 
000256 
000257 
000258 
000259 
000260 
000261 
000262 
000263 
000264 
000265 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 
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SELF.typeStyles.GetAt(i, @styl eChange) ; 
SELF. SetTypeStyle(styleChange. newSt yl e); 
Get Font! nfo(fl nfo); 


WITH flnfo DO 
IF oldTallest < ascent + descent + leading THEN 
BEGIN 
oldTallest := ascent + descent + leading 
tallestFont := flnfo 
END; 
END; 


width := SELF.Wdth(1, SELF.size); 
WITH extentLRect, baseLPt, tallestFont DO 


BEGIN 

top := v - ascent; 

bottom := v + descent + leading 
left :=h 


right := h + width; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 


PROCEDURE TParagraph. ChangeStyle(startLP, endLP: INTEGER; PROCEDURE Change(VAR typeStyle: TTypeStyle); 


VAR styleOfStartLP: TTypeStyle); 
VAR first Change: TStyl eChange 


tempChange: TStyl eChange 

prevChange: TStyl eChange 

styles: TArray; 

stylelndex: INTEGER; 

newSt yle: TTypeStyle 
BEGIN 


{$1FC fTrace}BP( 10); {$ENDC} 
{$IFC fParaTrace} 
1F fParaTrace THEN 

BEGIN 


WriteLn('=== Entering TParagraph. ChangeStyle: startLP=', startLP:1, ' endLP=', endLP:1) 


END; 
{$ENDC} 
styles := SELF. typeStyles 


stylelndex := 1; 
REPEAT 

stylelndex := stylelndex + 1; 

styles. GetAt(stylelndex, @tempChange); 
UNTIL tempChange.Ip >= startLP 


{If the change is on a run boundary, just remember the changed style at the beginning so 
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we can set styleOfStartLP later} 

[F tempChange.|p = startLP THEN 
BEGIN 
firstChange := tempChange 
Change(firstChange. newStyle); 
END 

ELSE 
BEGIN 
{Insert new run descriptor for beginning of changed characters} 
styles. GetAt(stylelndex - 1, @firstChange) 
prevChange := firstChange 
firstChange.|p := startLP 
Change(firstChange. newStyle); 
styles. InsAt(stylelndex, @firstChange); 
stylelndex := stylelndex + 1; 
END; 


{Change existing runs} 

WHILE (tempChange.|p < endLP) DO 
BEGIN 
prevChange := tempChange 
Change(tempChange. newStyl e) 
styles. PutAt(stylelndex, @tempChange) 
stylelndex := stylelndex + 1; 
styles. GetAt(stylelndex, @tempChange) 
END; 


{Don't restore old run info if new run info goes to end of para or ends on old run boundary} 
IF endLP < SELF.size THEN 
IF tempChange.|p <> endLP THEN 
BEGIN 
prevChange.|p := endLP 
styles. InsAt(stylelndex, @prevChange) ; 
END; 


SELF. Cl eanRuns; 


{return typestyle of beginning of run} 
styleOfStartLP := firstChange. newStyle 
{$IFC fTrace}EP; {$ENDC} 

END; 


{$$ SgTxtCld} 


PROCEDURE TParagraph. ChgFace(startLP, endLP: | NTEGER 


newOnFaces: {$lFC LibraryVersion <= 20}TSeteface{$ELSEC}Styl e{$ENDC}; 


VAR styleOfStartLP: TTypeStyle); 
PROCEDURE ChangeFace(VAR typeStyle: TTypeStyle); 
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BEGIN 

1F newOnFaces = [] THEN 
typeStyle.onFaces := [] 

ELSE 

typeStyle.onFaces := typeStyle.onFaces + newOnFaces 
END; 

BEGIN 
{$IFC fTrace}BP( 10); {$ENDC} 
SELF. ChangeStyle(startLP, endLP, ChangeFace, styleOfStartLP); 
{$I1FC fTrace}EP; {$ENDC} 

END; 


SgTxt Cl d} 
PROCEDURE TParagraph. ChgFontFamily(startLP, endLP: INTEGER; newFontFamily: Byte; 
VAR styleOfStartLP: TTypeStyle); 
PROCEDURE ChangeFamily(VAR typeStyle: TTypeStyle); 
BEGIN 
typeStyle.font.fontFamily := newFontFamily; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. ChangeStyle(startLP, endLP, ChangeFamily, styl eOfStartLP) 
{$SIFC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
PROCEDURE TParagraph. ChgFontSize(startLP, endLP: INTEGER; newFontSize: Byte 
VAR styleOfStartLP: TTypeStyle); 
PROCEDURE ChangeSize(VAR typeStyle: TTypeStyle); 
BEGIN 
typeStyle.font.fontSize := newFontSize 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. ChangeStyle(startLP, endLP, ChangeSize, styleOfStartLP); 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 

{Deletes redundant run information} 
PROCEDURE TParagraph. Cl eanRuns; 

VAR styl eChange: TStyl eChange 


prevChange: TStyl eChange 
styles: TArray; 
stylelndex: INTEGER 
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BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
styles := SELF.typeStyles 
styles. GetAt(1, @prevChange) 
stylelndex := 2; 
{lterate through the style changes and delete any that have either the same Ip as the previous 
change or the same font and faces info} 
WHILE stylelndex < styles.Size DO 
BEGIN 
styles. GetAt(stylelndex, @styl eChange) 
1F (styleChange.|p = prevChange.|p) OR 
((styleChange. newStyle.onFaces = prevChange. newStyle.onFaces) AND 
(styl eChange. newStyle.font.fontNum = prevChange. newStyle.font.fontNum)) THEN 
styles. Del At(styl el ndex) 
ELSE 
stylelndex := stylelndex + 1; 
prevChange := styl eChange; 


END; 
{$1FC fTrace}EP; {$ENDC} 


END; 
SgTxt Hot } 
PROCEDURE TParagraph. Draw(i: LONGINT; howMany: INTEGER) 
VAR dum nt: INTEGER; 
duml ndex: INTEGER 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
dumlindex := 1; 


SELF. Drawline(i-1, i + howMany - 2, TRUE, FALSE, dumint, dumlndex); 
{$IFC fTrace}EP; {$ENDC} 
END; 


TK2Start } 
PROCEDURE TParagraph. DrawLine(startLP, endLP: INTEGER; fDraw: BOOLEAN; fWidth: BOOLEAN 
VAR width: INTEGER; VAR stylelndex: INTEGER); 
{lf fDraw = TRUE, draws a line of characters fromstartLP to endLP; does not worry about word wrap 
lf fWdth = TRUE, returns width of characters. Also accepts an initial stylelndex (index into 
run array) to make typestyle scanning faster. Returns stylelndex of run of last character drawn. } 


{| DEAS TO MAKE THIS FASTER: 
special check to see if there are no typestyle changes in this para? 


VAR start PP: INTEGER 
endPP: INTEGER; 
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styl eChange: TStyl eChange 


prevChange: TStyl eChange 

tStyles: TArray; 

drawCount: INTEGER 
BEGIN 


{$1FC fTrace}BP( 10); {$ENDC} 
{$lFC fParaTrace} 
1F fParaTrace THEN 


BEGIN 
writeln('>> DrawLine: startLP=', startLP:1, ' endLP=', endLP:1, 
' —stylelndex=', stylelndex:1); 
WriteLn('>> DrawLine: fDraw=', fDraw, ' holeStart =', SELF. holeStart:1, 
' holeSize =', SELF. holeSize:1); 
END: 
{$ENDC} 
width := 0: 


tStyles := SELF.typeStyles; 
IF (stylelndex < 1) OR (stylelndex > tStyles.size) THEN 
stylelndex := 1; 


tStyles.GetAt(stylelndex, @styleChange); 
prevChange := styl eChange 
WHILE styleChange.Ip < startLP DO 
BEGIN 
prevChange := styleChange 
stylelndex := stylelndex + 1; 
tStyles. GetAt(stylelndex, @styleChange); 
END; 


PicText Begin(aLleft); 
SELF. SetTypeStyl e( prevChange. newSt yl e); 


{$IFC fParaTrace} 
1F fParaTrace THEN 
writeln('>> DrawLine: starting to Draw’); 
{$ENDC} 
WHILE startLP <= endLP DO 
BEGIN 
drawCount := MIN(styleChange.Ip, endLP+1) - startLP; 
1F fWidth THEN 
width := width + TString.Wdth(startLP+1, drawCount); 
1F fDraw THEN 
BEGIN 
{$1 FC fParaTrace} 
IF fParaTrace THEN 
writeln('>> DrawLine: About to call DrawText; startLP, drawCount=', startLP:1, 
',', drawCount:1); 
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000476 {$ENDC} 

000477 TString. Draw(startLP+1, drawCount); 

000478 END; 

000479 startLP := startLP + drawCount; 

000480 IF startLP = styleChange.|p THEN 

000481 BEGIN 

000482 {$1 FC fParaTrace} 

000483 IF fParaTrace THEN 

000484 writeln('>> DrawLine: found a typestyle change at LP=', startLP: 1) 
000485 {$ENDC} 

000486 SELF. SetTypeStyl e(styl eChange. newSt yl e) 

000487 stylelndex := stylelndex+l; 

000488 tStyles.GetAt(stylelndex, @styl eChange) 

000489 END; 

000490 END; 

000491 

000492 Pi cTextEnd 

000493 stylelndex := stylelndex-1; {return stylelndex of current typeStyle run} 
000494 {$IFC fParaTrace} 

000495 IF fParaTrace THEN 

000496 BEGIN 

000497 Writeln('>> DrawLine: Finished, width=', width: 1) 
000498 WriteLn; 

000499 END; 

000500 {$ENDC} 

000501 {$IFC fTrace}EP; {$ENDC} 

000502 END; 

000503 

000504 

000505 {$8 SgTxt Wrm} 

000506 PROCEDURE TParagraph. Fi ndWordBounds(orig: INTEGER; VAR first, last: INTEGER) 
000507 BEGIN 

000508 {$1FC fTrace}BP( 10); {$ENDC} 

000509 first := orig; 

000510 last := orig; 

000511 IF SELF.Qualifies(orig) THEN 

000512 BEGIN 

000513 WHILE SELF. Qualifies(first - 1) DO first := first - 1; 
000514 WHILE SELF. Qualifies(last + 1) DO last := last +13; 
000515 END; 

000516 IF last < SELF.size THEN 

000517 last := last+1; {always selects at least one character, except at end of para} 
000518 {$I FC fTrace}EP; {$ENDC} 

000519 END; 

000520 

000521 

000522 {$8 SgTxt Hot} 

000523 FUNCTION TParagraph. FixLP(LP: INTEGER): INTEGER 
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000524 BEGIN 

000525 {$1FC fTrace}BP( 6); {$ENDC} 

000526 IF LP < 0 THEN 

000527 FixLP := 0 

000528 ELSE |1F LP >= SELF.size THEN 

000529 FixLP := SELF.size 

000530 ELSE 

000531 FixLP := LP; 

000532 {$I1FC fTrace}EP; {$ENDC} 

000533 END; 

000534 

000535 

000536 {$8 SgTxtCld} 

000537 PROCEDURE TParagraph. NewStyle(startLP, endLP: INTEGER; newTypeStyle: TTypeStyle); 
000538 VAR styleOfStartLP: TTypeStyle 

000539 PROCEDURE ChgStyle(VAR typeStyle: TTypeStyle); 
000540 BEGIN 

000541 typeStyle := newTypeStyle; 

000542 END; 

000543 BEGIN 

000544 {$lFC fTrace}BP( 10); {$ENDC} 

000545 SELF. ChangeStyle(startLP, endLP, ChgStyle, styleOfStartLP); 
000546 {$I1FC fTrace}EP; {$ENDC} 

000547 END; 

000548 

000549 

000550 {$8 SgTxt Wrm} 

000551 FUNCTION TParagraph. Qualifies(pos: INTEGER): BOOLEAN 
000552 VAR i,j: INTEGER 

000553 left, this, right: CHAR 

000554 

000555 FUNCTION CharClass(ch: CHAR): CHAR 

000556 VAR c: INTEGER 

000557 BEGIN 

000558 c := ORD(ch); 

000559 IF c IN [65..90, 97..122, 128..159, 167, 174..175 
000560 187,.188, 190..191, 202] THEN ch :='A 
000561 ELSE 1F (48 <= c) AND (c <= 57) THEN ch := '9' 
000562 ELSE IF (c = 162) OR (c = 163) OR (c = 180) THEN ch := ''$' 
000563 CharClass := ch; 

000564 END; 

000565 

000566 FUNCTION CharAt(i: INTEGER): CHAR 

000567 BEGIN 

000568 1F i < 0 THEN 

000569 CharAt :=' ' 

000570 ELSE IF i >= SELF.size THEN 

000571 CharAt :=' ' 
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000572 ELSE 

000573 CharAt := SELF. At(i +1) 

000574 END; 

000575 

000576 BEGIN {Qualifies} 

000577 {$1FC fTrace}BP(9); {$ENDC} 

000578 left := CharClass(CharAt(pos-1)); 

000579 this := CharClass(CharAt(pos)) 

000580 right := CharClass(CharAt(pos+1)) 

000581 {$IFC fParaTrace} 

000582 IF fParaTrace THEN 

000583 WriteLn('IN QUALIFIES: left, this, right = (', left:1, this:1, right:1, ') => [' 
000584 ORD(left):1, ',', ORD(this):1, ',', ORD(right):1, ']'); 
000585 {$ENDC} 

000586 

000587 FOR i := 1 TO (LENGTH(wordDelimiters) + 1) DIV 4 DO 

000588 BEGIN 

000589 j := 4*i-2; { FOR j := 2 TO LENGTH(wordDelimiters) STEP 4 DO } 
000590 IF ((wordDelimiters[j-1]=left) OR (wordDelimiters[j-1] = 'x')) AND 
000591 (wordDelimiters[j] = this) AND 

000592 ((wordDelimiters[j+l]=right) OR (wordDelimiters[j+1]='x')) THEN 
000593 BEGIN 

000594 Qualifies := TRUE; 

000595 {$1FC fTrace}EP; {$ENDC} 

000596 EXI T( Qualifies); 

000597 END; 

000598 END; 

000599 Qualifies := FALSE; 

000600 {$I1FC fTrace}EP; {$ENDC} 

000601 END; 

000602 

000603 

000604 {$8 SgTxt Wrm} 

000605 PROCEDURE TParagraph. Repl Para(fPos, numChars: INTEGER; 

000606 otherPara: TParagraph; otherFPos, otherNumChars: INTEGER); 
000607 VAR styles: TArray; 

000608 otherStyles: TArray; 

000609 stylelndex: INTEGER 

000610 otherl ndex: INTEGER; 

000611 styl eChange: TStyl eChange 

000612 other Change: TStyl eChange 

000613 prevStyle: TTypeStyle 

000614 diff: | NTEGER; 

000615 endLP: INTEGER; 

000616 nextLP: INTEGER; 

000617 BEGIN 

000618 {$1FC fTrace}BP(9); {$ENDC} 

000619 otherPara. StopEdit; 
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SELF. Repl TString(fPos, numChars, otherPara, otherFPos, otherNumChars) 
IF otherNumChars > 0 THEN 
BEGIN 


{COPY THE TYPESTYLE RUN INFO TO SELF. typeStyles} 
otherStyles := otherPara.typeStyl es 
styles := SELF. typeStyles 
{Find out what run we're in in SELF} 
stylelndex := 1; 
REPEAT 
stylelndex := stylelndex+l; 
styles. GetAt(stylelndex, @styl eChange) 
UNTIL fPos <= styleChange. |p; 
nextLP := styl eChange. |p; 
IF fPos < nextLP THEN 
styles. GetAt(stylelndex-1, @styleChange); {back up one to get current run} 


{Find the first run in otherPara} 
otherlndex := 1; 
REPEAT 
otherlndex := otherl ndext+l; 
otherStyles.GetAt(otherlndex, @otherChange) 
UNTIL otherFPos < otherChange. |p; 
otherStyles. GetAt(otherlndex-1, @otherChange); 


diff := fPos - otherFPos 
endLP := otherfPos + otherNumChars; 
prevStyle := styleChange. newStyle 
{Insert the new run info but avoid consecutive run descriptors of the same info} 
otherChange.Ip := otherFPos 
WHILE otherChange.|p <= endLP DO 
BEGIN 
IF TFakeTStyle(otherChange. newStyle) <> TFakeTStyle(prevStyle) THEN 
BEGIN 
otherChange.I|p := otherChange.Ip + diff; 
styles.InsAt(stylelndex, @otherChange) 
stylelndex := stylelndex + 1; 
prevStyle := otherChange. newStyle 
END; 
otherStyles.GetAt(otherlndex, @otherChange) 
otherlndex := otherlndex + 1: 
END; 


{Insert descriptor of original run after the inserted info, unless we were on a run boundary 


or the last run has the same font and faces as the original run} 
1F fPos < nextLP THEN 
IF TFakeTStyle(styleChange. newStyle) <> TFakeTStyle(prevStyle) THEN 
BEGIN 
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styleChange.Ip := fPostotherNumChars 
styles. InsAt(stylelndex, @styl eChange) 
END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 


{$$ SgTxt Hot} 
PROCEDURE TParagraph. Repl PString(fPos, numChars: INTEGER 


BEGI 


END; 


VAR otherNumChars: INTEGER; 
N 
{$1FC fTrace}BP( 9); {$ENDC} 


{ make fPos lie within [0..# chars in paragraph] } 
fPos := SELF. fixLP(fPos); 


IF pStr = NIL THEN 
otherNumChars := 0 
ELSE 
otherNumChars := Length( pStr%*); 


SELF. StartEdit(otherNumChars); 
SELF. Del ManyAt(fPos + 1, numChars) 
* 


SELF. UpdateRuns(fPos,-numChars); 

*) 

IF pStr <> NIL THEN 
SELF.InsPStrAt(fPos + 1, pStr); 

SELF. StopEdit; 


SELF. UpdateRuns(fPos, numChars, otherNumChars); 
{$I FC fTrace}EP; {$ENDC} 


{$$ SgTxtHot } 
PROCEDURE TParagraph. Repl TString(fPos, numChars: INTEGER 
otherString: TString; otherFPos, otherNumChars: | NTEGER) 


BEGI 


N 
{$1 FC fTrace}BP(9); {$ENDC} 


{ make fPos lie within [0..# chars in paragraph] } 
fPos := SELF. fixLP(fPos); 


SELF. StartEdit(otherNumChars); 


1F numChars > 0 THEN 


pStr: TPString); 
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SELF. Del ManyAt(fPos + 1, numChars); 


IF (otherString <> NIL) AND (otherNumChars > 0) THEN 
SELF.I nsManyAt(fPos + 1, otherString, otherFPos + 1, otherNumChars) 


SELF. StopEdit; 


SELF. UpdateRuns(fPos, numChars, otherNumChars); 
{$I FC fTrace}EP; {$ENDC} 
END; 


TK2Start} 
PROCEDURE TParagraph. SetTypeStyle(tStyle: TTypeStyle); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SetQDTypeStyle(tStyle); 
{$SIFC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 


PROCEDURE TParagraph. StyleAt(Ip: INTEGER; VAR typeStyle: TTypeStyle) 


VAR styl eChange: TStyl eChange 


styles: TArray; 
stylelndex: INTEGER 
BEGIN 


{$IFC fTrace}BP(9); {$ENDC} 

styles := SELF.typeStyles 

stylelndex := 1; 

styles. GetAt(1, @styl eChange) 

WHILE styleChange.Ip <= Ip DO 
BEGIN 
typeStyle := styleChange. newStyle 
stylelndex := stylelndex+l; 
styles. GetAt(stylelndex, @styl eChange) 
END; 


{§lFC fTrace}EP; {$ENDC} 


END; 
SgTxt Hot } 
PROCEDURE TParagraph. UpdateRuns(atLP: INTEGER; replacedChars: 
VAR tStyles: TArray 
i: | NTEGER; 
aChange: TStyl eChange 
tempChange: TStyl eChange 
prevStyle: TTypeStyle 
last Deleted: INTEGER; 
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000764 BEGIN 

000765 {$IFC fTrace}BP( 8); {$ENDC} 

000766 tStyles := SELF.typeStyles; 

000767 lastDeleted := -1; 

000768 heels 

000769 WHILE ij <= tStyles.size DO 

000770 BEGIN 

000771 tStyles.GetAt(i, @aChange); 

000772 IF atLP <= aChange.|p THEN 

000773 BEGIN 

000774 IF i < tStyles.size THEN 

000775 aChange.I|p := aChange.Ip - replacedChars; 

000776 

000777 {if we deleted some chars, we must delete associated run info} 
000778 IF aChange.|p <= atLP THEN 

000779 BEGIN 

000780 {save type style since we may have deleted only part of this run} 
000781 tempChange := aChange; 

000782 

000783 {assume whole run deleted, reinsert later if not} 
000784 tStyles. Del At(i); 

000785 lastDeleted := i; 

000786 i :=i-1; 

000787 END 

000788 ELSE 

000789 BEGIN 

000790 IF i = lastDeleted THEN 

000791 {put back run info for last run deleted if part of it still remains and is not 
000792 the same as the run before the changes} 
000793 1F (aChange.Ip <> atLP) AND 

000794 (TFakeTStyle(tempChange. newStyle) <> TFakeTStyle(prevStyle)) THEN 
000795 BEGIN 

000796 tempChange.I|p := atLP + insertedChars; 
000797 tStyles.InsAt(i, @tempChange); 

000798 i := itl; 

000799 END; 

000800 IF i < tStyles.size THEN 

000801 BEGIN 

000802 aChange.|p := aChange.Ip + insertedChars; 
000803 tStyles. PutAt(i, @aChange); 

000804 END; 

000805 END; 

000806 END 

000807 ELSE 

000808 prevStyle := aChange. newStyle; 

000809 i := itl; 

000810 END; 

000811 {$I1FC fTrace}EP; {$ENDC} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 781 of 1012 


000812 
000813 
000814 
000815 
000816 
000817 
000818 
000819 
000820 
000821 
000822 
000823 
000824 
000825 
000826 
000827 
000828 
000829 
000830 
000831 
000832 
000833 
000834 
000835 
000836 
000837 
000838 
000839 
000840 
000841 
000842 
000843 
000844 
000845 
000846 
000847 
000848 
000849 
000850 
000851 
000852 
000853 
000854 
000855 
000856 
000857 
000858 
000859 


END; 


Apple Lisa Computer Technical 


Information 


{$$ TK2Start} 


FUNCTION TParagraph. Wi dth(i 


VAR 


BEGI 


END; 


LONGI NT; howMany: 
theWi dth: 
duml ndex: 
N 

{$1FC fTrace}BP( 10); {$ENDC} 
dumindex := 1; 
SELF. DrawLi ne(i-1, 
Width := theWdth; 
{$1FC fTrace}EP; {$ENDC} 


INTEGER; 
INTEGER; 


i + howMany - 2, FALSE, 


{$$ SgTxtI ni} 


BEGIN 


fParaTrace := 


END; 


METHODS 


FALSE; 


OF TEditPara; 


{$$ SgTxtCld} 


FUNCTION TEditPara. CREATE( object: TObject; heap: THeap; 
itsFormat: 


VAR 
BEGI 


imgList: TList; 
N 
{$1FC fTrace}BP( 10); {$ENDC} 
IF object = NIL THEN 

obj ect 
SELF 


imgList := TList.CREATE(NIL, heap, 0); 
WITH SELF DO 
BEGIN 
bsCount := 0; 
nestLevel := 0 
format := itsFormat; 
beingFiltered := FALSE; 
(* 
numl mages := 0; 
maxl mages := 1; 
images[1] := NIL; 
* 
images := imgList; 
END; 


itsFormat. ChangeRef Count By( 1); 
{$1FC fTrace}EP; {$ENDC} 
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INTEGER): INTEGER; 


TRUE, theWidth, 


initial Si 
TParaFormat): 


:= NewDynObject(heap, THISCLASS, initial Size); 
:= TEditPara(TParagraph. CREATE(object, heap, initial Size 


duml ndex); 


ze: INTEGER; 
TEdit Para; 


itsFormat.dfltTStyle)); 
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000860 
000861 
000862 
000863 
000864 
000865 
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000872 
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000875 
000876 
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000878 
000879 
000880 
000881 
000882 
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000884 
000885 
000886 
000887 
000888 
000889 
000890 
000891 
000892 
000893 
000894 
000895 
000896 
000897 
000898 
000899 
000900 
000901 
000902 
000903 
000904 
000905 
000906 
000907 


END; 
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{$$ SgTxtCld} 
PROCEDURE TEdit Para. Free 


BEGI 


END; 


N 

{$1FC fTrace}BP( 10); {$ENDC} 

SELF. format. ChangeRef Count By(-1); 

SELF.images.FreeQbject; {Free the list, but not its members} 
SUPERSELF. Free: 

{$1FC fTrace}EP; {$ENDC} 


{$$ SgTxtCld} 
{$I FC fParaTrace} 
PROCEDURE TEdit Para. Fields( PROCEDURE Field(nameAndType: $255)); 


VAR 
BEGI 


END; 
{$ENDC} 


str: STR255; 

N 

SUPERSELF. Fields( Field); 
Field('bsCount: I NTEGER' ) 
Field('nestLevel: | NTEGER'); 
Field('format: TParaFormat' ) 
Field('beingFiltered: BOOLEAN’ ) 
(* 


Field('maxl mages: I NTEGER'); 
Field('numl mages: I NTEGER' ) 
IntToStr(SELF.numl mages, @str); 


Field(CONCAT('i mages: ARRAY[1..', CONCAT(str, '] OF TParalmage'))); 


= 
Field('images: TList'); 
Field(''); 


{$$ SgTxt Hot} 
PROCEDURE TEditPara. Begininsertion(atLP: INTEGER; size:|INTEGER); 
{Changes the text buffer so that the empty space is located at position atLP 
expands the buffer (if necessary) so that there is at least size empty characters. 
ze = 0 means about to backspace; this does nothing if the paragraph is already 


(si 


} 
BEGI 


setup to backspace at atLP.) 


{$1FC fTrace} BP(6); {$ENDC} 
IF (atLP <> SELF. holeStart) OR (size <> 0) THEN {nothing to do--must be backspacing} 


BEGIN 

SELF. EditAt(atLP + 1, size); 
SELF. bsCount := 0 

END; 
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{$1FC fTrace} EP; {$ENDC} 
END; 


mn 


{$S SgTxtCld} 
PROCEDURE TEditPara. Dell mage(dell mage: TParal mage; fFree: BOOLEAN) 
BEGIN 

{$1FC fTrace}BP( 10); {$ENDC} 

SELF. images. Del Obj ect(dellmage, fFree); 

{$I FC fTrace}EP; {$ENDC} 


END; 


mn 


{$$ SgTxtCld} 

{Selectively delete paralmages fromlist based on Function Parameter} 
PROCEDURE TEditPara. Del! mgl F( FUNCTION ShouldDelete( paral mage: TParal mage) 
VAR s: TListScanner; 


paral mage: TParal mage 
(* 


i: INTEGER; 
numDeleted: INTEGER 
* 


BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
s := SELF.i mages. Scanner 
WHILE s.Scan(paral mage) DO 
IF ShouldDel ete(paral mage) THEN 
s. Del ete( FALSE); 
(* 
numDeleted := 0; 
WITH SELF DO 


WHILE i <= numl mages DO 
BEGIN 
{$R-} {$H-} 
1F ShouldDelete(images[i]) THEN 
numDeleted := numDeletedt1l 
ELSE IF numDeleted > 0 THEN 
images[i-numDeleted] := images[i]; 
{$I1FC fRngText}{$R+}{$ENDC} {$H+} 
i := itl; 
END; 
IF numDeleted > 0 THEN 


FOR i := (numl mages-numDeleted+1) TO numl mages DO 


{$R- } 


images[numl mages] := NIL; 
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000956 {$I FC fRngText}{$R+}{$ENDC} 
000957 numl mages := numl mages-numDel eted 
000958 END; 

000959 END; 

000960 *) 

000961 {$IFC fTrace}EP; {$ENDC} 

000962 END; 

000963 

000964 

000965 {$8 SgTxtCld} 

000966 PROCEDURE TEditPara. Eachl mage( PROCEDURE | mageProc(paral mage: TParal mage) ) 
000967 (* 

000968 VAR i: INTEGER; 

000969 *) 

000970 PROCEDURE Dolt(object: TObj ect); 

000971 BEGIN 

000972 | mageProc(TParal mage( obj ect)); 
000973 END; 

000974 BEGIN 

000975 {$1FC fTrace}BP( 10); {$ENDC} 

000976 SELF. i mages. Each(Dolt); 

000977 (* 

000978 FOR i := 1 TO SELF. numl mages DO 

000979 {$R-} ImageProc(SELF.images[i]); {$IFC fRngText}{$R+}{$ENDC} 
000980 a 

000981 {$I1FC fTrace}EP; {$ENDC} 

000982 END; 

000983 

000984 

000985 {$8 SgTxtHot} 

000986 PROCEDURE TEdit Para. Endl nsertion; 

000987 {After calling this: 

000988 holeStart = emptyPos = # chars in paragraph 
000989 } 

000990 BEGIN 

000991 {$1FC fTrace}BP( 6); {$ENDC} 

000992 SELF. StopEdit; 

000993 SELF. bsCount := 0 

000994 {$I1FC fTrace}EP; {$ENDC} 

000995 END; 

000996 

000997 

000998 {$8 SgTxtHot } 

000999 FUNCTION TEdit Para. GrowSize: INTEGER; 
001000 BEGIN 

001001 {$IFC fTrace}BP( 6); {$ENDC} 

001002 GrowSize := 200 

001003 {$I1FC fTrace}EP; {$ENDC} 
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001005 
001006 
001007 
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001009 
001010 
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001021 
001022 
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001038 
001039 
001040 
001041 
001042 
001043 
001044 
001045 
001046 
001047 
001048 
001049 
001050 
001051 


{$8 


{$8 


{$8 
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END; 


SgTxt Hot } 
PROCEDURE TEditPara. I nsertOneChar(ch: CHAR; atLP: INTEGER); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. Beginlnsertion(atLP, 1); { UNDO} 
{ now we have SELF. holeStart = atLP } 
SELF. PutAt(atLP+1, ch); 
SELF.UpdateRuns(atLP, 0, 1); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
PROCEDURE TEditPara.Inslmage(paral mage: TParal mage) 
(* 
VAR i: | NTEGER; 
found: BOOLEAN; 
x 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. images. I nsLast( paral mage); 
(* 


IF SELF. numl mages = SELF. maxl mages THEN 
BEGIN 


SELF. ResizeCollection(SELF.size + SELF. holeSize + 4); 
SELF. ShiftCollection(0, 4, SELF.size + SELF. hol eSi ze); 


WITH SELF DO 
BEGIN 
dynStart := dynStart + 4; 
maxl mages := maxl mages + 1; 
END; 
END; 
WITH SELF DO 
BEGIN 
numl mages := numl mages + 1; 
{$R-} 
images[numl mages] := paral mage 
{$1 FC fRngText}{$R+}{$ENDC} 
END; 
* 
{$1FC fTrace}EP; {$ENDC} 
END; 
SgTxt Hot } 


PROCEDURE TEditPara. SetTypeStyle(tStyle: TTypeStyle) 
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BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. format. SetTypeStyle(tStyle); 
{$I1FC fTrace}EP; {$ENDC} 


END; 
{$$ SgTxtI ni} 
END; 
METHODS OF TLinel nfo; 


{$$ SgTxt Wrm} 


FUNCTION TLinel nfo. CREATE( object: TObject; heap: THeap): TLinel nfo; 


BEGIN 
{$I1FC fTrace}BP( 6); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TLinelnfo(obj ect); 
WITH SELF DO 
BEGIN 
valid := FALSE; 
startLP := 0; 
lastDrawnLP := 0; 
endLP := 0; 
lineLRect := zeroLRect 
lineAscent := 0: 


END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$S SgTxtCld} 
{$I FC fParaTrace} 


PROCEDURE TLinel nfo. Fields( PROCEDURE Field(nameAndType 


BEGIN 
SUPERSELF. Fields(Field); 
Field('valid: BOOLEAN’ ) 
Field('startLP: I NTEGER' ) 
Field('lastDrawnLP: I NTEGER'); 
Field('endLP: I NTEGER' ) 
Field('lineLRect: LRect'); 
Field('lineAscent: INTEGER’) 
Field(''); 

END; 

{$ENDC} 


{$$ SgTxt Hot} 


FUNCTION TLinel nfo. LeftCoord(proposedLeft Pixel: LONGINT) 
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001147 


{$8 


{$S 


END; 
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BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
{Default is to not change the parameter; TLinelnfo subclassers may choose to do otherwise} 
LeftCoord := proposedLeft Pixel 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
FUNCTION TLinel nfo. RightCoord(proposedRi ght Pixel: LONGINT): LONGINT; 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
{Default is to not change the parameter; TLinelnfo subclassers may choose to do otherwise} 
RightCoord := proposedRi ght Pi xel 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxtl ni } 


METHODS OF TParal mage; 


{$8 


SgTxt Wr m} 
FUNCTION TParal mage. CREATE(object: TObject; heap: THeap; itsView: TView; itsParagraph: TEditPara; 
itsLRect: LRect; lineTop: LONGINT; lineLeft: LONGINT): TParal mage 


VAR aLineLlist: TList; 
linel nfo: TLi nel nfo; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TParalmage(Tl mage. CREATE(object, heap, itsLRect, itsView)); 
SELF. paragraph := itsParagraph; 
SELF.extentLRect := itsLRect; 
aLineList := TList.CREATE(NIL, heap, 0); 
linelnfo := SELF. DfltLinelnfo(lineTop, lineLeft); 
aLineList.InsLast(linelnfo); 


WITH SELF DO 
BEGIN 
height := linelnfo.lineLRect. bottom - linelnfo.lineLRect.top; 
lineList := aLineList; 
tickcount := 0; 
changed := TRUE; 
startLP := 0; 
endLP := 0: 
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END; 


Apple Lisa Computer Technical Information 


textl mage := NIL; 
wasOffset := FALSE; 
END; 


{$IFC fTrace}EP; {$ENDC} 


{$$ SgTxt Wrm} 
PROCEDURE TParal mage. Free 


BEGI 


END; 


N 
{$1 FC fTrace}BP( 10); {$ENDC} 
Free(SELF.lineList); 


(* Since caller of this may be scanning the paragraph's image list we can't delete it fromthe 


list here lest we screw up the caller's scanner. So the caller wil 


SELF. paragraph. Dell mage( SELF, FALSE) 
x) 


SUPERSELF. Free; 
{$I1FC fTrace}EP; {$ENDC} 


{$$ SgTxtCld} 
{$1 FC fParaTrace} 
PROCEDURE TParal mage. Fields( PROCEDURE Field(nameAndType: $255) ) 


BEGI 


END; 
{$ENDC} 


N 

SUPERSELF. Fields(Field); 
Field(' paragraph: TEditPara'); 
Field(' height: INTEGER') 
Field('lineList: TList'); 
Field('changed: BOOLEAN'); 
Field('tickCount: | NTEGER'); 
Field('startLP: | NTEGER' ) 
Field('endLP: I NTEGER' ) 
Field('textl mage: TTextl mage' ) 
Field('wasOffset: BOOLEAN'); 
Field(''); 


{$$ SgTxt Hot } 
PROCEDURE TParal mage. AdjustLineLPs(atLP, deltaLP: INTEGER); 
{positive deltaLP implies character(s) were inserted, negative deltaLP implies they were deleted} 


PROCEDURE Adj ustLP(obj: TObject); 
BEGIN 
WITH TLinelnfo(obj) DO 
BEGIN 
{$H- } 
IF startLP > atLP THEN 
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startLP := Max(atLP, startLP + deltaLP); 
IF lastDrawnLP > atLP THEN 


lastDrawnLP := Max(atLP, lastDrawnLP + deltaLP) 


IF endLP > atLP THEN 
endLP := Max(atLP, endLP + deltaLP) 
{$H+} 
END; 
END; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. lineList.Each( Adj ust LP) 
WITH SELF DO 
BEGIN 
{$H- } 
IF startLP > atLP THEN 
startLP := Max(atLP, startLP + deltaLP); 
IF endLP >= atLP THEN 
endLP := Max(atLP, endLP + deltaLP) 
{$H+} 
END: 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtHot } 


PROCEDURE TParal mage. ComputeLinel nfo(curLine: TLinel nfo; 
VAR next LP: 


N 
{$lFC fTrace}BP( 10); {$ENDC} 
{$I FC fTrace}EP; {$ENDC} 


{$$ SgTxt Wrm} 


maxLineLen: INTEGER 
INTEGER; VAR | RectNeeded: LRect); 


FUNCTION TParal mage. DfltLinelnfo(lineTop: LONGINT; lineLeft: LONGI NT) 


VAR linel nfo: TLi nel nfo 


fl nfo: FontI nfo 

i: INTEGER; 

format: TParaFormat; 
BEGIN 


{$1FC fTrace}BP( 9); {$ENDC} 
linelnfo := TLinel nfo, CREATE(NIL, SELF. Heap); 


format := SELF. Get Format; 
format. SetTypeStyle(format.dfltTStyle); 
Get FontI nfo(finfo); 


i := SELF. paragraph.size 


TLi nel nfo; 
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WITH linelnfo, flnfo, format DO 
BEGIN 
lastDrawnLP := i; 
endLP := i: 
lineAscent := ascent; 
{$H- } 


SetLRect(lineLRect, lineLeft, lineTop, lineleft, 
spaceAbovePara + lineTop + ascent + descent + leading + spaceBel owPara); 
OffsetLRect(lineLRect, SELF.extentLRect.left + firstIindent, SELF.extentLRect.top); 


{$H+} 
END; 
DfltLinelnfo := linelnfo; 
{$I FC fTrace}EP; {$ENDC} 
END; 
SgTxt Hot } 


PROCEDURE TParal mage. DrawLine(startLP: INTEGER; fDraw: BOOLEAN; stopWidth, wrapWidth: 
VAR lineWdth, lastToDraw, endLP: INTEGER); 
{Figures out what characters to draw based on a variety of input constraints. 
Returns: 
lineWdth: the width of the line calculated (including trailing spaces) [??] 
lastToDraw: the Ip of the last non blank character in the line 
endLP: the Ip of the last character in the line (may be a blank) } 


INTEGER; 


{NOTE: the wrapWidth parameter may eventually be dropped and instead calculated from SELF. extentLRect 
and certain format fields} 


LABEL 1; 

VAR ¢: 
startPP: 
curl ndex: 
styl eChange: 
prevChange: 
styles: 
stylelndex: 
firstStylelndex: 
cWidth: 
max PP: 
endPP: 
breakI ndex: 
breakCount: 
breakLen: 
paragraph: 
format: 
drawStart: 
drawCount: 
dummy : 


Apple 


CHAR; 

I NTEGER; 
INTEGER; 
TStyl eChange; 
TStyl eChange; 
TArray; 

| NTEGER; 
INTEGER; 

| NTEGER; 

| NTEGER; 
INTEGER; 

I NTEGER; 

| NTEGER; 
INTEGER; 
TEdit Para: 
TParaFor mat; 
INTEGER; 

I NTEGER; 

I NTEGER; 


{ PP of last character looked at } 
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001327 
001328 
001329 
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001338 
001339 


maXxL 
BEGIN 
{$1F 
{$1F 
1F f 
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P; | NTEGER; 


C fTrace}BP( 10); {$ENDC} 

C fParaTrace} 

ParaTrace THEN 

writeln('** DrawLine: startLP=', startLP:1, ', maxLP=', maxLP:1, 
', stopWdth=',stopWdth:1, ', wrapWdth=', wrapWidth: 1); 


{$ENDC} 


maXxL 


P := SELF. paragraph. size-1; 


IF maxLP < startLP THEN 


ELSE 


BEGIN 

lineWdth := 0; 
lastToDraw := maxLP 
endLP := maxLP; 

END 


BEGIN 
paragraph := SELF. paragraph; 
format := SELF. Get Format; 


breakI ndex := 0 
lastToDraw := 0: 
lineWdth := 0; 
cWdth := 0: 


curlndex := paragraph. FixLP(startLP) 
styles := paragraph. typeStyles 
styles. GetAt(1, @styl eChange); 
stylelndex := 1; 
REPEAT 

prevChange := styleChange 

stylelndex := stylelndex + 1; 

styles. GetAt(stylelndex, @styl eChange) 
UNTIL curlndex < styl eChange. |p; 


format. SetTypeStyl e( prevChange. newStyle); 
firstStylelndex := stylelndex-1; 


startPP := curl ndex; 
maxPP := MIN( paragraph.size, paragraph. Fi xLP(maxLP)); 


{$1 FC fParaTrace} 
1F fParaTrace THEN 
writeln('** DrawLine: About enter loop, maxPP =', maxPP: 1, 
' holeSize=', paragraph. hol eSi ze: 1); 
{$ENDC} 
WHILE curlndex <= maxPP DO 
BEGIN 
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IF curlndex = styleChange.|Ip THEN 
BEGIN 
format. SetTypeStyle(styl eChange. newStyl e); 
stylelndex := stylelndex+l; 
styles. GetAt(stylelndex, @styl eChange) 
END; 


C := paragraph. At(curl ndex+1); 


cWdth := CharWdth(c); 
{$I FC fParaTrace AND FALSE} 
1F fParaTrace THEN 
writel n('curlndex=', curlndex:1, ', char=', c, ', cWdth=', 
cWdth:1, ', lineWdth=',lineWdth: 1); 


{$ENDC} 


{Drop out of loop if lineWidth > stopWidth unless 
we're at end of line and have trailing spaces} 
1F (lineWdth + cWdth > stopWdth) THEN 
1F format.wordWrap AND (stopWidth = wrapWidth) THEN 
IF (c <> ' ') THEN 
GOTO 1 


GOTO 1; 


IF format. wordWrap AND (c = ' ') THEN 
BEGIN 


IF (breakIl ndex + 1) < curlndex THEN {so we don't drawtrailing blanks} 


lastToDraw := curl ndex-1; 


breakI ndex := curlndex; 
breakLen := lineWdth; 
END; 
lineWdth := lineWdth + cWidth:; 
curlndex := curlndex + 1; 
cWdth := 0: 
END; 
ndex := curlndex - 1: 


IF format. wordWrap AND (lineWdth + cWidth > wrapWidth) AND (breakIl ndex > 0) THEN 


ELSE 


{ PRIMITIVE WORD WRAP! } 


BEGIN 

lineWdth := breakLen: 
curl ndex := breaki ndex: 
END 
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001388 lastToDraw := curlndex; 

001389 

001390 {$1 FC fParaTrace} 

001391 1F fParaTrace THEN 

001392 writeln('** DrawLine: About to figure endLP, curlndex =', curl ndex: 1) 
001393 {$ENDC} 

001394 

001395 endLP := curl ndex; 

001396 

001397 {$I FC fParaTrace} 

001398 IF fParaTrace THEN 

001399 writeln('** DrawLine: endLP figured =', endLP: 1); 

001400 {$ENDC} 

001401 

001402 IF (lastToDraw >= 0) AND fDraw THEN 

001403 SELF. Fast DrawLine( paragraph. fixLP(startLP), lastToDraw, TRUE, 
001404 FALSE, dummy, firstStylelndex); 
001405 END; 

001406 

001407 {$1FC fParaTrace} 

001408 1F fParaTrace THEN 

001409 BEGIN 

001410 writeln('** DrawLine done: endLP=',endLP:1,', lineWdth=',lineW dth: 1) 
001411 writeln('** DrawLine done: final lastToDraw=',!astToDraw: 1) 

001412 WriteLn; 

001413 END; 

001414 {$ENDC} 

001415 {$I1FC fTrace}EP; {$ENDC} 

001416 END; 

001417 

001418 

001419 {$8 SgTxtHot} 

001420 PROCEDURE TParal mage. DrawParal mage(limitLRect: LRect; startLP: | NTEGER; drawAction: TDrawActi on; 
001421 inval Bits: BOOLEAN; VAR drawnLRect: LRect); 
001422 {Note: DrawParal mage now assumes that the paragraph was changed} 

001423 LABEL 1; 

001424 VAR paragraph: TEdit Para; 

001425 fl nfo: Fontl nfo; 

001426 li nel nfo: TLi nel nfo 

001427 firstLinelnfo: TLinelnfo 

001428 lineList: TList; 

001429 lineSpacing: INTEGER 

001430 curBase: LONGI NT; 

001431 left Margin: LONGI NT; 

001432 curLP: INTEGER; 

001433 endLP: INTEGER; 

001434 numChars: INTEGER 

001435 lineLen: INTEGER; 
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001436 
001437 
001438 
001439 
001440 
001441 
001442 
001443 
001444 
001445 
001446 
001447 
001448 
001449 
001450 
001451 
001452 
001453 
001454 
001455 
001456 
001457 
001458 
001459 
001460 
001461 
001462 
001463 
001464 
001465 
001466 
001467 
001468 
001469 
001470 
001471 
001472 
001473 
001474 
001475 
001476 
001477 
001478 
001479 
001480 
001481 
001482 
001483 


BEGIN 
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maxLineLen: INTEGER 
li nel ndex: INTEGER; 
pixel: LONGI NT; 
last DrawnLP: INTEGER 
testLPoint: LPoint; 
format: TParaFor mat; 
firstFudge: INTEGER 
start OfNewPara: BOOLEAN 
anLRect: LRect; 
sLine: TListScanner: 
genRest: BOOLEAN 
genBef ore: BOOLEAN 
ol dEndLP: INTEGER 
prevLi nel nfo: TLi nel nf 0; 
prevLen: INTEGER 
prevPl mage: TParal mage 
prevTxtl mage: TTextl mage 
origStart: INTEGER; 
dummy : INTEGER; 
stylelndex: INTEGER 
ri LRect; 
{$IFC fParaTrace} 
str: STR255; 
{$ENDC} 
{$1FC fTrace}BP( 10); {$ENDC} 
{$IFC fParaTrace} 
1F fParaTrace THEN 
BEGIN 
WITH limitLRect DO 
WriteLn('## Entering DrawParal mage: limitLRect=[(',left:1,',',top:1,'),(', 
right:1,',', bottomi1,')]'); 
Li ntToHex(ORD(SELF), @str); 
Wri teLn( : SELF = ', str,' startLP=',startLP:1,' drawAction=', ORD( drawAction)); 
END; 
{$ENDC} 
drawnLRect := limitLRect; 


endLP := startLP; 
paragraph := SELF. paragraph; 


f or mat 
IF drawAction 
tickCount 


Pi cGr pBegi n; 
PenNor mal 


:= SELF. Get Format; 


actionDraw THEN WITH SELF DO 


r= (tickCount+1) MOD MAXI NT; 


genRest := FALSE; 
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001484 genBefore := FALSE; 

001485 curLP := startLP 

001486 numChars := paragraph. size 

001487 SELF.startLP := curLP 

001488 

001489 format. SetTypeStyle(format.dfltTStyle); 

001490 Get FontI nf o( fi nfo) 

001491 WITH fl nfo DO 

001492 lineSpacing := ascent + descent + leading + format.lineSpacing 
001493 

001494 lineList := SELF.lineLlist; 

001495 curBase := limitLRect.top; 

001496 prevLinelnfo := NIL; 

001497 IF linelList.Size > 0 THEN 

001498 BEGIN 

001499 sLine := lineList. Scanner 

001500 {If existing linelnfo's start after startLP then we need to generate preceeding linelnfo's} 
001501 IF TLinelnfo(linelList.First).startLP > startLP THEN 
001502 BEGIN 

001503 origStart := TLinelnfo(lineList. First). startLP 
001504 genBefore := TRUE; 

001505 END 

001506 ELSE WHILE sLine.Scan(linelnfo) DO 

001507 BEGIN 

001508 {delete lineinfo's that start before the startLP parameter} 
001509 IF linelnfo.endLP < startLP THEN 

001510 sLine. Del et e( TRUE) 

001511 ELSE 

001512 BEGIN 

001513 IF linelnfo.valid THEN 

001514 BEGIN 

001515 prevLinelnfo := linelnfo; 

001516 curBase := linelnfo.lineLRect. bottom 
001517 END 

001518 ELSE 

001519 GOTO 1; 

001520 END; 

001521 END; 

001522 END 

001523 ELSE 

001524 linelnfo := NIL: 

001525 

001526 1: 

001527 1F NOT genBefore THEN 

001528 IF linelnfo = NIL THEN 

001529 BEGIN 

001530 genRest := TRUE; 

001531 curLP := Max(startLP, SELF. endLP); 
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001532 END 

001533 ELSE 

001534 curLP := Max(startLP, linelnfo.startLP); 

001535 

001536 startOfNewPara := curLP = 0; 

001537 

001538 curBase := curBase + flnfo.ascent; 

001539 IF startOfNewPara THEN 

001540 BEGIN 

001541 curBase := curBase + format.spaceAbovePara; 

001542 leftMargin := limitLRect. left + format. firstIndent; 

001543 { The first line maxLineLen might be different (due to firstI ndent) } 
001544 firstFudge := format. firstIl ndent - format. leftIndent; 

001545 END 

001546 ELSE 

001547 BEGIN 

001548 leftMargin := limitLRect. left + format. leftindent; 

001549 firstFudge := 0; 

001550 END; 

001551 

001552 limitLRect. left := limitLRect.left + format.leftIndent; 

001553 limitLRect. right := limitLRect.right - format. rightI ndent; 

001554 

001555 maxLineLen := lengthLRect(limitLRect, h) - firstFudge; {if firstIlndent is to left of 
001556 leftindent, fudge will be negative} 
001557 

001558 SetLPt(testLPoint, limitLRect.left, curBase + flnfo. descent) 

001559 

001560 {$I FC fParaTrace} 

001561 1F fParaTrace THEN 

001562 BEGIN 

001563 WriteLn('## DrawParal mage: Entering Drawline loop -- leftMargin=',leftMargin:1, 
001564 ' curBase=',curBase: 1); 

001565 END; 

001566 {$ENDC} 

001567 

001568 {don't bother going into the loop if we can't fit the first line or we've run out 
001569 of characters already (eg: empty para) } 

001570 IF (NOT LPtIinLRect(testLPoint, limitLRect)) OR (curLP >= numChars) THEN 
001571 BEGIN 

001572 SELF. extentLRect := drawnLRect; 

001573 IF NOT genRest THEN 

001574 BEGIN 

001575 r := linelnfo.lineLRect; 

001576 r.left := linelnfo.LeftCoord( SELF. textl mage. extentLRect.left-1) 
001577 r.right := linelnfo. RightCoord(SELF.textI mage. extentLRect. right +1) 
001578 linelnfo := SELF. DfltLinel nfo(0, 0) 

001579 r. bottom := linelnfo.lineLRect. bottom 
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001580 
001581 
001582 
001583 
001584 
001585 
001586 
001587 
001588 
001589 
001590 
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001615 
001616 
001617 
001618 
001619 
001620 
001621 
001622 
001623 
001624 
001625 
001626 
001627 
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sLine.Replace(linelnfo, TRUE); 
genRest := NOT sLine. Scan(linel nfo); 
END; 

{These two assignments distinguish (for the calling routine) whether an empty 
paragraph did or did not fit in the limitLRect. Assuming curLP = 0, SELF.endLP 
will be 0 for a paragraph that did fit and -1 for one that did not fit. The calling 
routine checks this value against paragraph.size to see if the paragraph fit} 

IF LPtinLRect(testLPoint, limitLRect) THEN 

BEGIN 
SELF.endLP := curLP 
{Erase the old line} 
[F drawAction = actionDraw THEN 
FillLRect(r, | Pat White) 
ELSE IF drawAction = actionlnval THEN 
thePad. Inval LRect(r); 
END 
ELSE 
SELF.endLP := curLP-1: 
{$1 FC fParaTrace} 
[F fParaTrace THEN 
BEGIN 
WriteLn('## DrawParal mage: Empty para or cannot fit; endLP set to ', SELF. endLP: 1) 
END; 
{$ENDC} 
END 
{Otherwise, set up lineLRect and call Drawline while there are still characters to display 
and we still fit in limitLRect} 
ELSE 

BEGIN 

{Layout line previous to first invalid line to see if characters fromthe 
invalid line can wrap back. First, however, we must check for special case 
of the previous line being in another textl mage. } 

1F NOT startOfNewPara AND (prevLinelnfo = NIL) THEN 

BEGIN 
prevTxtl mage := SELF. textl mage. prevTxtl mg; 
IF prevTxtl mage <> NIL THEN 
BEGIN 
prevPl mage := TParal mage(prevTxtl mage. i mageList. Last); 
prevLinelnfo := TLinelnfo(prevPl mage.lineList. Last); 
prevLen := LengthLRect(prevPl mage.extentLRect, h) - format. leftIndent 
- format. rightI ndent; 
END; 
END 
ELSE 
BEGIN 
prevLen := maxLineLen; 
prevPl mage := SELF; 
E 
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IF prevlLinelnfo <> NIL THEN 
BEGIN 
oldEndLP := prevLinel nfo. endLP; 
1F prevLinelnfo.startLP = 0 THEN 
prevLen := prevLen - (format. firstindent - format. leftIndent); 


prevPl mage. DrawLine(prevLinelnfo.startLP, FALSE, prevLen, prevLen, 
lineLen, lastDrawnLP, endLP) 


IF endLP <> oldEndLP THEN 


BEGIN 

SELF. text! mage. useFirstPixel := FALSE; 

r := prevlinelnfo.lineLRect; 

r.left := prevlinel nfo. LeftCoord( prevPl mage. text! mage. extentLRect.left-1); 


r.right := prevLinelnfo. RightCoord( prevPl mage. textl mage. extentLRect.right+1) 


IF drawAction = actionDraw THEN 


BEGIN 
FillLRect(r, | Pat White); 
stylelndex := 1; 


MoveToL(prevLinelnfo.lineLRect. left, 
prevLinelnfo.lineLRect. top+prevLi nel nfo.lineAscent); 
SELF. Fast DrawLine(prevLinelnfo.startLP, lastDrawnLP, TRUE, 
FALSE, dummy, stylelndex); 
END 
ELSE IF drawAction = actionlnval THEN 
thePad. I nvalLRect(r); 


WITH prevlinelnfo.lineLRect DO 


BEGIN 

prevLinelnfo.valid := inval Bits 

right := left + lineLen; 
prevLinelnfo.lastDrawnLP := |astDrawnLP; 


prevLinelnfo.endLP := endLP; 
curLP := endLP + 1; 
prevPl mage. endLP := curLP 
IF curLP >= numChars THEN 
IF (bottom + format.spaceBelowPara) <= limitLRect. bottom THEN 
BEGIN 
r.top := bottom 
bottom := bottom + format. spaceBel owPara; 
r.bottom:= bottom 
{$H- } 
IF drawAction = actionDraw THEN 
FillLRect(r, | Pat White) 
ELSE IF drawAction = actionlnval THEN 
thePad. I nvalLRect(r); 
{$H+} 
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END; 
END; 
END; 

END; 
WITH flnfo DO 

SetLRect(anLRect, leftMargin, curBase - ascent, 

leftMargin + maxlineLen, curBase + descent + | eading) 

leftMargin := limitLRect.left 
{Setup GrafPort for first line (after prev line) } 
IF drawAction = actionDraw THEN 

MoveToL(leftMargin + firstFudge, curBase); 


WHILE (curLP < numChars) AND (LPtInLRect(testLPoint, limitLRect)) DO 
BEGIN 
IF genRest OR genBefore THEN 
linelnfo := TLinelnfo. CREATE( NIL, paragraph. heap); 


1F NOT linelnfo. valid THEN 


BEGIN 
WITH fl nfo, linelnfo DO 
BEGIN 
startLP := curLP; 
lineAscent := ascent; 
lineLRect := anLRect; 
END; 
r := anLRect; 
r.left := linelnfo. LeftCoord( SELF. text! mage. extentLRect.|eft-1) 
[F SELF. textl mage. useFirstPixel THEN 
BEGIN 
r.left := Max(r.left, SELF. textl mage.firstLinePixel); 
SELF.textl mage. useFirstPixel := FALSE; 
END; 
r.right := linelnfo. Ri ghtCoord(SELF. text! mage. extentLRect. right +1) 


IF drawAction = actionDraw THEN 
FillLRect(r, | Pat White) 

ELSE IF drawAction = actionlnval THEN 
thePad. I nval LRect(r); 


oldEndLP := linel nfo. endLP: 


SELF. DrawLine(curLP, drawAction = actionDraw, maxLineLen, maxLineLen, 
lineLen, l|astDrawnLP, endLP) 


{$1 FC fParaTrace} 
| F 


(curLP > endLP) AND (curLP < numChars) THEN 
BEGIN 
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001724 ABCbreak('loop in DrawParal mage; curLP=',curLP); 
001725 endLP := curLP + 1; 

001726 END; 

001727 {$ENDC} 

001728 

001729 {finish setting up new linelnfo} 

001730 WTH flnfo, linelnfo.lineLRect DO 

001731 BEGIN 

001732 linelnfo.lastDrawnLP := |astDrawnLP 

001733 linelnfo.endLP := endLP 

001734 right := left + lineLen; 

001735 

001736 {if this is last line in paragraph, add spaceBelowPara, unless that extra amount 
001737 would put it ouside of the limitLRect} 

001738 IF (endLP+l) >= numChars THEN 

001739 IF (bottom + format.spaceBelowPara) <= limitLRect. bottom THEN 
001740 BEGIN 

001741 r.top := bottom; 

001742 bottom := bottom + format. spaceBel owPara; 
001743 r.bottom:= bottom 

001744 {$H- } 

001745 IF drawAction = actionDraw THEN 

001746 FillLRect(r, | Pat White) 

001747 ELSE IF drawAction = actionlnval THEN 
001748 thePad. I nvalLRect(r); 

001749 {$H+} 

001750 END: 

001751 END; 

001752 

001753 {lf the word being typed wrapped down to the next line, we need to erase 
001754 the piece of the word that was on this line. } 

001755 IF r.left > linelnfo.lineLRect. right THEN 

001756 BEGIN 

001757 r.left := linelnfo.lineLRect. right; 

001758 IF drawAction = actionDraw THEN 

001759 FillLRect(r, | Pat White) 

001760 ELSE IF drawAction = actionlnval THEN 

001761 thePad. I nvalLRect(r); 

001762 END; 

001763 

001764 IF genRest THEN 

001765 lineList. InsLast(linelnfo) 

001766 ELSE IF genBefore THEN 

001767 sLine.Append(linelnfo); {leaves scanner poised before the original first linel nfo} 
001768 

001769 linelnfo. valid := inval Bits 

001770 END 

001771 ELSE {linelnfo is valid} 
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001772 BEGIN 

001773 endLP := linelnfo. endLP 

001774 oldEndLP := endLP 

001775 END; 

001776 

001777 {This field is used by caller in case the entire paragraph didn't fit, so that the 
001778 caller knows where to start subsequent display} 
001779 SELF.endLP := endLP + 1; 

001780 {Setup for next line} 

001781 curLP := endLPtl; 

001782 curBase := curBase + lineSpacing 

001783 maxLineLen := maxLineLen + firstFudge 

001784 firstFudge := 0; 

001785 |F genBefore THEN 

001786 genBefore := origStart > curLP 

001787 

001788 1F NOT (genRest OR genBefore) THEN 

001789 BEGIN 

001790 IF sLine. Scan(linelnfo) THEN 

001791 IF linelnfo.startLP <> curLP THEN 

001792 linelnfo.valid := FALSE 

001793 ELSE 

001794 ELSE 

001795 genRest := TRUE; 

001796 END; 

001797 

001798 { setup GrafPort and lineRect for next line} 
001799 [F drawAction = actionDraw THEN 

001800 MoveToL(leftMargin, curBase) 

001801 WITH flnfo DO 

001802 SetLRect(anLRect, 

001803 leftMargin, curBase - ascent, 

001804 leftMargin + maxLineLen, curBase + descent + leading); 
001805 SetLPt(testLPoint, leftMargin, testLPoint.v + lineSpacing) 
001806 END; {WHILE} 

001807 END; {IF} 

001808 {We don't want to delete the linelnfo we just sLine. appended so advance scanner} 
001809 1F genBefore THEN 

001810 sLine. Ski p(1); 

001811 IF NOT genRest THEN 

001812 REPEAT 

001813 sLine. Del et e( TRUE); 

001814 UNTIL NOT sLine. Scan(linel nfo) 

001815 

001816 [F SELF.changed THEN 

001817 SELF. changed := NOT inval Bits 

001818 

001819 Pi cGrpEnd; 
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001820 

001821 linelnfo := TLinelnfo(SELF.lineList. Last); 

001822 firstLinelnfo := TLinel nfo(SELF.linelist. First) 

001823 SELF. height := linelnfo.lineLRect. bottom - firstLinelnfo.lineLRect.top 

001824 drawnLRect. bottom:= linelnfo.lineLRect. bottom 

001825 

001826 SELF.extentLRect := drawnLRect; 

001827 

001828 {$IFC fParaTrace} 

001829 1F fParaTrace THEN 

001830 BEGIN 

001831 WITH drawnLRect DO 

001832 WriteLn('## Exiting DrawParal mage: drawnLRect=[(',left:1,',',top:1,'),(', 
001833 right:1,',', bottom1,')]', 
001834 '; height = ', SELF. hei ght: 1) 
001835 END; 

001836 {$ENDC} 

001837 

001838 {$1FC fTrace}EP; {$ENDC} 

001839 END; 

001840 

001841 

001842 {$8 SgTxtCld} 

001843 PROCEDURE TParal mage. Draw 

001844 BEGIN 

001845 {$1FC fTrace}BP( 10); {$ENDC} 

001846 SELF. RedrawLines(0, MAXI NT) 

001847 {$I1FC fTrace}EP; {$ENDC} 

001848 END: 

001849 

001850 

001851 {$8 SgTxt Hot} 

001852 PROCEDURE TParal mage. FastDrawLine(startLP, endLP: INTEGER; fDraw: BOOLEAN; fWidth: BOOLEAN 
001853 VAR width: INTEGER; VAR stylelndex: INTEGER); 

001854 {lf fDraw = TRUE, draws a line of characters fromstartLP to endLP; does not worry about word wrap 
001855 If fWidth = TRUE, returns width of characters. Also accepts an initial stylelndex (index into 
001856 run array) to make typestyle scanning faster. Returns stylelndex of run of last character drawn. } 
001857 

001858 VAR saveFormat: TParaFormat; 

001859 paragraph: TEditPara 

001860 format: TParaformat; 

001861 BEGIN 

001862 {$1 FC fTrace}BP(10); {$ENDC} 

001863 paragraph := SELF. paragraph; 

001864 saveFormat := paragraph. format; 

001865 format := SELF. Get Format; 

001866 paragraph. format := format 

001867 paragraph, DrawLine(startLP, endLP, fDraw, fWdth, width, stylelndex) 
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paragraph. format := saveFormat; 
{$I FC fTrace}EP; {$ENDC} 
END; 
{$$ SgTxt Hot} 


{Returns paragraph's paraFormat; can be overriden by application} 
FUNCTION TParal mage. GetFormat: TParaFor mat 
VAR stylelndex: INTEGER 
BEGI N 
{$I1FC fTrace}BP(7); {$ENDC} 
GetFormat := SELF. paragraph. format; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TParal mage.I nvalLinesWith(startLP, endLP: | NTEGER) 


VAR s: TListScanner; 
li nel nfo: TLi nel nfo; 
prevLi nel nfo: TLi nel nf 0; 
numChars: INTEGER 

BEGIN 


{$IFC fTrace}BP( 9); {$ENDC} 
SELF.changed := TRUE; 
s := SELF.lineList. Scanner; 
IF s.Scan(prevLinel nfo) THEN 
BEGIN 
WHILE s.Scan(linelnfo) DO 
BEGIN 
{If its already invalid, don't muck with it} 
IF prevLinelnfo. valid THEN 
prevLinelnfo.valid := (linelnfo.startLP <= startLP) OR (prevLinelnfo.startLP > endLP) 
prevLinelnfo := linelnfo 
END; 


{last line} 
1F prevLinelnfo.valid THEN 
BEGIN 
numChars := SELF. paragraph. size 
prevLinelnfo.valid := (numChars < startLP) OR (prevLinelnfo.startLP > endLP) 
END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Wrm} 
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PROCEDURE TParal mage. LineWithLPt( pt: LPoint; VAR linelndex: INTEGER; VAR linelnfo: TLinelnfo) 
VAR s: TListScanner: 


nxtLninfo: TLinelnfo 


{$1 FC fTrace}BP( 8); {$ENDC} 

{$IFC fParaTrace} 

IF fParaTrace THEN 

writeln('in LineWithLPt, point=(,',pt.hi1,', ',pt.vil,')'); 


{$ENDC} 
s := SELF.Jinelist.scanner; {&&& maybe could use TList.scannerFrom(i ndex) } 
linelndex := 1: 


{This has been modified to allow for the possibility of multiple lineRects at the same 
vertical coordinate } 
IF s.Scan(linelnfo) THEN 
WHILE s.scan(nxtLninfo) DO 
BEGIN 
IF (pt.v < linelnfo.lineLRect. bottom) AND 
((pt.h < linelnfo.lineLRect. right) OR (pt.v < nxtLnIinfo.lineLRect.top)) THEN 


s. Done 

ELSE 
BEGIN 
linelndex := linelndex + 1; 
linelnfo := nxtLninfo 
END; 

END 

ELSE 
BEGIN 


{$l FC fParaTrace} 
1F fParaTrace THEN 
writeln(chr(7), '‘LineWthLPt: no TLinelnfo in TParal mage, linel ndex=0'); 
{$ENDC} 
linelndex := 1; 
linelnfo := SELF. DfltLinelnfo(0, 0); 
SELF. lineList.I nsLast(linel nfo); 
END; 
{$I1FC fTrace}EP; {$ENDC} 


{$$ SgTxt Hot} 
PROCEDURE TParal mage. LocateLP(LP: INTEGER; VAR linelndex: INTEGER; VAR pixel: LONGINT); 
VAR s: TListScanner; 


IstLninfo: TLinelnfo 
li nel nfo: TLi nel nfo; 


BEGIN 


{$1 FC fTrace}BP(8); {$ENDC} 
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001964 1F LP < 0 THEN 

001965 LP := 0; 

001966 s := SELF.lineList. Scanner; 

001967 linelndex := 0: 

001968 

001969 WHILE s.Scan(linelnfo) DO 

001970 BEGIN 

001971 IF LP < linelnfo.startLP THEN 

001972 s. Done 

001973 ELSE 

001974 BEGIN 

001975 linelndex := linelndex + 1; 

001976 IstLninfo := linelnfo 

001977 END; 

001978 END; 

001979 

001980 IF linelndex=0 THEN 

001981 BEGIN 

001982 {$I FC fParaTrace} 

001983 IF fParaTrace THEN 

001984 writeln(chr(7), ‘LocateLP: no TLinelnfo in TParal mage, l|inelndex=0') 
001985 {$ENDC} 

001986 linelndex := 1; 

001987 linelnfo := SELF. DfltLinelnfo(0, 0) 

001988 pixel := linelnfo.lineLRect.left - 1; { leave 1 pixel space before character } 
001989 SELF. lineList.I nsLast(linel nfo) 

001990 END 

001991 ELSE 

001992 BEGIN 

001993 pixel := IstLninfo.lineLRect.left + SELF. ParaTextWdth(IstLninfo.startLP, LP-1) - 1; 
001994 { leave 1 pixel space before character } 
001995 END; 

001996 {$I1FC fTrace}EP; {$ENDC} 

001997 END; 

001998 

001999 

002000 {$8 SgTxt Hot} 

002001 FUNCTION TParal mage. LpWithLPt(pt: LPoint): INTEGER 

002002 VAR linelndex: INTEGER 

002003 li nel nfo: TLi nel nfo 

002004 endLP: INTEGER; 

002005 li neLen: INTEGER 

002006 char Wid: INTEGER 

002007 paragraph: TEditPara 

002008 wrapMargin: INTEGER 

002009 lastLP: INTEGER; 

002010 PROCEDURE Drawline(obj: TObject); {This routine gets filtered after a type style change} 
002011 BEGIN 
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002012 SELF. Drawline(linelnfo.startLP, FALSE, pt.h-linelnfo.lineLRect.left, wrapMargin, 
002013 lineLen, lastLP, endLP); 

002014 END; 

002015 BEGIN 

002016 {$I1FC fTrace}BP( 8); {$ENDC} 

002017 SELF. LineWithLPt(pt, linelndex, linel nfo) 

002018 IF pt.v < linelnfo.lineLRect.top THEN 

002019 pt := linelnfo.lineLRect.topleft 

002020 ELSE IF pt.v > linelnfo.lineLRect. bottom THEN 

002021 pt := linelnfo.lineLRect. botRi ght 

002022 ELSE 

002023 LRectHaveLPt(linelnfo.lineLRect, pt) 

002024 

002025 paragraph := SELF. paragraph; 

002026 wrapMargin := lengthLRect(SELF.extentLRect, h) 

002027 

002028 SELF. FilterAndDo(SELF, DrawLine); 

002029 

002030 { endLP is now the LP of the character before the character the cursor was over} 
002031 lineLen := lineLen + linelnfo.lineLRect. left 

002032 { lineLen is now the x-coord of screen position of endLP (right pixel) } 
002033 

002034 endLP := MIN(endLP+1, paragraph. size) 

002035 charWd := SELF. paraTextWidth(endLP, endLP); { find width of the char under cursor } 
002036 {$I FC fParaTrace} 

002037 1F fParaTrace THEN 

002038 writeln('LpWthLPt: endLP=', endLP:1, ' pt.h=', pt.h:1, '  linelLen=', lineLlen:1, 
002039 '  charWid=', charWid:1); 

002040 {$ENDC} 

002041 [F 2*(pt.h-lineLen) >= charWd THEN { pt is right of center of char } 
002042 LpWithLPt := paragraph. fixLP(endLP+1) 

002043 ELSE { pt is left of center of char } 
002044 LpWithLPt := paragraph. fixLP(endLP); 

002045 {$I1FC fTrace}EP; {$ENDC} 

002046 END; 

002047 

002048 

002049 {$8 SgTxtCld} 

002050 PROCEDURE TParal mage. OffsetBy(deltaLPt: LPoint); 

002051 VAR s: TListScanner 

002052 li nel nfo: TLi nel nfo 

002053 BEGIN 

002054 {$1FC fTrace}BP( 10); {$ENDC} 

002055 {&&& should make sure the results falls within view} 

002056 WITH deltaLPt DO 

002057 BEGIN 

002058 {$H- } OffsetLRect(SELF.extentLRect, h, v); {$H+} 

002059 s := SELF./inelist. Scanner 
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002060 
002061 
002062 
002063 
002064 
002065 
002066 
002067 
002068 
002069 
002070 
002071 
002072 
002073 
002074 
002075 
002076 
002077 
002078 
002079 
002080 
002081 
002082 
002083 
002084 
002085 
002086 
002087 
002088 
002089 
002090 
002091 
002092 
002093 
002094 
002095 
002096 
002097 
002098 
002099 
002100 
002101 
002102 
002103 
002104 
002105 
002106 
002107 


{$8 


{$8 


Apple Lisa Computer Technical Information 


WHILE s.Scan(linelnfo) DO 
{$H-} OffsetLRect(linelnfo.lineLRect, h, v); {$H+} 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
{Returns width of characters in range startLP, endLP. (NOTE: startLP=endLP for width of one char) } 
FUNCTION TParal mage. ParaTextWidth(startLP, endLP: INTEGER): INTEGER 


VAR stylelndex: INTEGER 
wi dth: INTEGER; 
PROCEDURE FastDraw(obj: TObject); {This routine gets filtered after a type style change} 
BEGIN 
SELF. FastDrawLine(startLP, endLP, FALSE, TRUE, width, stylelndex) 
END; 
BEGIN 
{$IFC fTrace}BP( 8); {$ENDC} 
stylelndex := 1; 
IF endLP < startLP THEN 
width := 0 
ELSE 


SELF. FilterAndDo(SELF, Fast Draw) 
ParaTextWidth := width; 
{$IFC fTrace}EP; {$ENDC} 


END; 
SgTxt Hot } 
PROCEDURE TParal mage. Redrawlines(startLine: INTEGER; endLine: INTEGER); 
VAR s: TListScanner; 
i: INTEGER; 
li nel nfo: TLi nel nfo; 
prevLi nel nfo: TLinel nfo 
stylelndex: INTEGER 
dummy : INTEGER; 
PROCEDURE FastDraw(obj: TObject); {This routine gets filtered after a type style change} 
BEGIN 
SELF. Fast Drawline(linelnfo.startLP, linelnfo.lastDrawnLP, TRUE, 
FALSE, dummy, stylelndex); 
END; 
BEGIN 


{$1FC fTrace}BP( 10); {$ENDC} 
Pi cGr pBegi n; 


s := SELF.lineList. Scanner; 

i := 0; 

endLine := Min(endLine, SELF.lineList. Size); 
startLine := Max(startLine, 1) 
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002108 
002109 
002110 
002111 
002112 
002113 
002114 
002115 
002116 
002117 
002118 
002119 
002120 
002121 
002122 
002123 
002124 
002125 
002126 
002127 
002128 
002129 
002130 
002131 
002132 
002133 
002134 
002135 
002136 
002137 
002138 
002139 
002140 
002141 
002142 
002143 
002144 
002145 
002146 
002147 
002148 
002149 
002150 
002151 


End of 


{$8 


{$$ 
END; 


{$8 


File -- 


styl el ndex 
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121; 


WHILE 5, scan(linel nfo) DO 


BEGIN 


i := itl; 


IF i < startLine THEN {nothing} 
ELSE 


BEGI 


IF LRectisVisible(linelnfo.lineLRect) THEN 


IF i 


END; 
END; 
Pi cGrpEnd; 


BEGIN 

{$1 FC fParaTrace} 

1F fParaTrace THEN 

writel n('## ReDrawLines: About to call FastDraw; i=', i:1); 

{$ENDC} 

MoveToL(linelnfo.lineLRect. left, linelnfo.lineLRect.toptlinelnfo.lineAscent); 
SELF. FilterAndDo(SELF, FastDraw); 

END; 

= endLine THEN 
s. Done; 


{$I1FC fTrace}EP; {$ENDC} 


END; 


SgTxt Cl d} 


FUNCTION TParal mage. SeesSameAs(image: Tl mage): BOOLEAN 


BEGIN 


{$1FC fTrace}BP( 6); {$ENDC} 
[F SELF = image THEN 
SeesSameAs := TRUE 


ELSE 1F NOT 


InClass(image, TParal mage) THEN 


SeesSameAs := FALSE 


ELSE 


SeesSameAs := SELF. paragraph = TParal mage(i mage). paragraph; 
{$SIFC fTrace}EP; {$ENDC} 


END; 


SgTxtl ni } 
SgTxtl ni } 


Lines: 2151 Characters: 71585 
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000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 
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{UText 3} 
{TStyleSheet, TText, TTextl mage, TTextView, TTextWriteUnivText} 


{changed 05/11/84 1135 Changed TText!l mage.Inval All to call panel. InvalLRect} 

{changed 04/26/84 1308 Changed TTextWriteUnivText. Fill Run to TText WriteUnivText. Fill Paragraph} 

{changed 04/25/84 1250 Changed FilterAndDo calls back to filtering TParal mage for Compugraphic} 

{changed 04/25/84 1135 Do same for TText. MarkChanged as for HiliteParagraphs bel ow} 

{changed 04/24/84 1637 Make TText.HiliteParagraphs use selection's textIl mage to call HiliteText} 

{changed 04/20/84 1102 Modified TTextl mage.| mageWith so that if it finds an image whose endLP equals 
the passed Ip then it may continue the scan, favoring the paral mage whose 
textl mage equals SELF} 

{changed 04/17/84 1349 Erase/Invalidate bottom of textIl mage BEFORE calling nextTxtl mg. Recomputel mages; 

Fix boundary condition bug in TTextl mage. Recomputel mages} 

{changed 04/17/84 1110 Numerous additional explicit deletions of paral mages from paragraph. i mages} 

{changed 04/16/84 1539 Set last parameter in NewView call in TTextView. CREATE to FALSE} 

{changed 04/16/84 1446 Put picture comments in TTextI mage. Draw} 

{changed 04/16/84 1015 Explicitly delete paral mages from paragraph.images in TText! mage. Recomputel mages} 

{changed 04/13/84 1818 Removed test to see if any paral mages in first textl mage in TText.HiliteText and 
TText. MarkChanged} 

{changed 04/13/84 1537 Changed calls to FilterAndDo to pass TEditPara rather than TParal mage} 

{changed 04/13/84 0209 Added TTextl mage. NewEdit Para} 

{changed 04/10/84 1400 Changed references to TEditPara.images in DelPara, Dell magesWith, and | mageWi th} 

{changed 04/09/84 1337 Use deferUpdate in DrawOrlnval and Recompute to decide if we should draw now} 


{$$ SgTxt Hot} 


METHODS OF TStyleSheet 


{$$ SgTxtI ni} 
FUNCTION TStyleSheet. CREATE(object: TObject; heap: THeap): TStyleSheet; 
VAR aList: TlList; 
BEGIN 
{$1 FC fTrace}BP( 6); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TStyl eSheet (obj ect); 
alist := TList. CREATE(NIL, heap, 0) 
SELF.formats := aList; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
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000044 
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000067 
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000069 
000070 
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000074 
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000088 
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000090 
000091 
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PROCEDURE TStyl eSheet. Free 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
Free(SELF.formats); 
SUPERSELF. Free: 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtI ni} 
PROCEDURE TStyleSheet.InitDefault; 
VAR paraFormat: TParaFormat; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
paraFormat := TParaFormat.CREATE(NIL, SELF.Heap, SELF); 
SELF. formats. |nsLast(paraFor mat); 
{$IFC fTrace}EP; {$ENDC} 
END: 


{$S SgTxtCld} 
{$l FC fTextTrace} 


PROCEDURE TStyleSheet. Fields( PROCEDURE Field(nameAndType: $255) ) 
BEGIN 
SUPERSELF. Fields( Field); 
Field('formats: TList'); 
Field(''); 
END; 
{$ENDC} 
{$$ SgTxtI ni} 


END; {Methods of TStyleSheet} 


METHODS OF TTextRange; 


{$$ SgTxt Hot} 
FUNCTION TTextRange. CREATE(object: TObject; heap: THeap; 
beginPara: TEditPara; beginlndex: LONGINT; beginLP: INTEGER 
endPara: TEditPara; endindex: LONGINT; endLP: INTEGER): TText Range 
BEGIN 
{$IFC fTrace}BP(6); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TTextRange( obj ect); 
WITH SELF DO 
BEGIN 
firstPara := beginPara; 
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000092 
000093 
000094 
000095 
000096 
000097 
000098 
000099 
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000104 
000105 
000106 
000107 
000108 
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000132 
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000134 
000135 
000136 
000137 
000138 
000139 
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firstIl ndex := beginlndex; 
firstLP := beginLP 
lastPara := endPara; 
lasti ndex := endl ndex: 
lastLP := endLP: 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S SgTxtCld} 
{$I FC fTextTrace} 


PROCEDURE TText Range. Fields( PROCEDURE Field( nameAndType 


BEGIN 
SUPERSELF. Fields( Field); 
Field('firstPara: TEditPara'); 
Field('firstlndex: LONGI NT') 
Field('firstLP: | NTEGER' ) 
Field('lastPara: TEditPara' ) 
Field('lastindex: LONGINT'); 
Field('lastLP: INTEGER’ ) 
Field(''); 
END; 
{$ENDC} 
{$$ SgTxtCld} 


PROCEDURE TText Range. Adj ustBy(delta: INTEGER); 
BEGIN 

{$1FC fTrace}BP( 10); {$ENDC} 

{$IFC fTrace}EP; {$ENDC} 


{$$ SgTxtI ni} 
E ' 


METHODS OF TText 
{$$ SgTxtI ni} 


FUNCTION TText.CREATE(object: TObject; heap: THeap; 
VAR aList: TList; 
anotherList: TList; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
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$255)); 


itsStyleSheet: TStyleSheet): TText; 
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000140 
000141 
000142 
000143 
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SELF := TText(object); 


alist := TList.CREATE(NIL, heap, 0) 
anotherList := TList.CREATE(NIL, heap, 0) 
WITH SELF DO 

BEGIN 

paragraphs := aList; 

txt mgList := anotherList; 

styleSheet := itsStyl eSheet; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
PROCEDURE TText. Free 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. FreeSel f (TRUE); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S SgTxtCld} 
{$I FC fTextTrace} 


PROCEDURE TText.Fields( PROCEDURE Field(nameAndType: $255)); 


BEGIN 
SUPERSELF. Fields( Field); 
Field('paragraphs: TList'); 
Field('styleSheet: TStyleSheet'); 
Field('txtIlmgList: TList'); 
Field(''); 

END; 

{$ENDC} 


{$S SgTxtCld} 
PROCEDURE TText. FreeSelf(freeParas: 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF.txtl mgList. Free 
IF freeParas THEN 
Free( SELF. paragraphs) 
ELSE IF SELF.paragraphs <> NIL THEN 
SELF. paragraphs. FreeObj ect; 
SUPERSELF. Free; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


BOOLEAN) ; 


{Free the paragraphs} 
{ OR 


{Just Free the list} 
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{$$ SgTxt Wrm} 
PROCEDURE TText. ChangeSell nOtherPanels(textSelection: TTextSel ection) 


BEG 


END 


PROCEDURE ChngPanel Sel(obj: TObject); 


VAR 


BEGI 


END; 


textl mage: TTextl mage 

selection: TSelection; 

panel: TPanel: 

N 

{$1 FC fTrace}BP(10); {$ENDC} 

text] mage := TTextl mage( obj); 

panel := text! mage. vi ew. panel 

selection := panel.selection; 

{We only unhighlight and replace the last non-NIL coSelection. In most cases, where 
there is no coSelection, we unhighlight and replace the panel selection and 
everything is hunky-dory} 

WHILE selection.coSelection <> NIL DO 

selection := selection. coSel ection; 


{Don't change selection in same panel } 
IF selection. panel <> textSelection. panel THEN 

selection := selection. FreedAndRepl acedBy(textSel ection. ReplicateFor Other Panel (text! mage) ); 
{$1 FC fTrace}EP; {$ENDC} 


{$1FC fTrace}BP( 10); {$ENDC} 
[F SELF.txtIlmglist.size > 1 THEN 


SELF. txtl mgList. Each( ChngPanel Sel ); 


{$I1FC fTrace}EP; {$ENDC} 


{$$ SgTxtCld} 
PROCEDURE TText. Del Para(del Para: TEditPara; fFree: BOOLEAN) 


VAR 


BEGI 


(* 
i: 
numl 
*) 
5 


INTEGER; 
mages: INTEGER 


TListScanner: 


paral mage: TParal mage 
N 


{$lFC fTrace}BP( 10); {$ENDC} 
(* 


numl 
FOR 
*) 


sis 


mages := del Para. Numl mages; 
i := 1 TO numil mages DO 


del Para. images. Scanner 


WHILE s.Scan(paral mage) DO 
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000236 
000237 
000238 
000239 
000240 
000241 
000242 
000243 
000244 
000245 
000246 
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000252 
000253 
000254 
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000256 
000257 
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000259 
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000267 
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000271 
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000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 


{$8 


{$8 
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paral mage := del Para.images[1] 

*) 

paral mage.textl mage. i mageList. Del Obj ect(paralmage, FALSE); 
s. Del ete( FALSE); 

paral mage. Free 

END; 

{NOTE: We do not delete the paragraph from our own paragraphs list because this is usually 
called while scanning that list and we would screw up its scanner if we removed the 
paragraph fromthe list} 

|F fFree THEN 

del Para. free; 
{$1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
PROCEDURE TText. Draw 
PROCEDURE Drawi nl mage(obj: TObject); 
VAR textl mage: TTextl mage 
PROCEDURE DrawOnPad; 
BEGIN 
textl mage. Draw 
END; 
BEGIN 
text] mage := TTextl mage( obj); 
text! mage. view. panel. OnAl | Pads Do( DrawOnPad) 
END; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. txtl mgList. Each( Drawi nl mage) 
{$I1FC fTrace}EP; {$ENDC} 
END: 


SgTxt Hot } 
PROCEDURE TText.HiliteRange(highTransit: THighTransit; textRange: TTextRange; wholePara: BOOLEAN) 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
WITH textRange DO 
{$H- } 
SELF. HiliteParagraphs(highTransit, firstIlndex, firstLP, lastIlndex, lastLP, whol ePara) 
{$H+} 
{$IFC fTrace}EP; {$ENDC} 
END; 
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000284 {$8 SgTxt Hot} 


000285 { TText. HiliteParagraphs tells each text image to hilite its panel's text selection on each pad. It 
000286 calls TTextl mage. HiliteText which assumes we are already focussed on a pad } 

000287 PROCEDURE TText.HiliteParagraphs(highTransit: THighTransit; 

000288 startIl ndex: LONGINT; startLP: INTEGER 

000289 endindex: LONGINT; endLP: INTEGER; wholePara: BOOLEAN) 
000290 PROCEDURE Hilitelnl mage(obj: TObject); 

000291 VAR selection: TSelection; 

000292 textl mage: TTextl mage 

000293 

000294 PROCEDURE HiliteOnPad 

000295 BEGIN 

000296 textl mage. HiliteText(highTransit, startIlndex, startLP, endilndex, endLP, wholePara); 
000297 END; 

000298 BEGIN 

000299 selection := TTextl mage(obj).view. panel.selecti on; 

000300 WHILE selection.coSelection <> NIL DO 

000301 selection := selection. coSel ection; 

000302 textl mage := TTextSelection(selection).textl mage 

000303 textl mage. view. panel. OnAl | PadsDo( HiliteOnPad); 

000304 END; 

000305 BEGIN 

000306 {$IFC fTrace}BP( 10); {$ENDC} 

000307 SELF. txtl mgList. Each( Hilitel nl mage) 

000308 {$I1FC fTrace}EP; {$ENDC} 

000309 END; 

000310 

000311 

000312 {$8 SgTxtI ni} 

000313 FUNCTION TText. DfltTextl mage(view: TView; imageLRect: LRect; imglsGrowable: BOOLEAN): TTextl mage 
000314 VAR textl mage: TTextl mage 

000315 BEGI N 

000316 {$l FC fTrace}BP( 10); {$ENDC} 

000317 textl mage := TTextl mage. CREATE(NIL, SELF.Heap, view, imageLRect, SELF, imglsGrowable); 
000318 SELF. txtl mgList. | nsLast(textl mage) 

000319 SELF. paragraphs. | nsLast(textl mage. NewEditPara(0, TParaFormat(SELF.styleSheet. formats. First) )) 
000320 SELF. Recomputel mages; 

000321 DfltTextl mage := text! mage 

000322 {$1FC fTrace}EP; {$ENDC} 

000323 END; 

000324 

000325 

000326 {$8 SgTxtCld} 

000327 PROCEDURE TText. I nsParaAfter(existingPara: TEditPara; newPara: TEditPara); 

000328 

000329 PROCEDURE InsertPara(obj: TObj ect); 

000330 BEGIN 

000331 TTextl mage(obj).I nsertNewPara(existingPara, newPara) 
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END; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. txtl mgList. Each(Insert Para); 
SELF. paragraphs. | nsAt(SELF. paragraphs. Pos(0, existingPara) + 1, newPara) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
PROCEDURE TText.Invalidate; 


PROCEDURE Invall nimage(obj: TObject); 
VAR textl mage: TTextl mage 
PROCEDURE I nval OnPad 
BEGIN 
textl mage. | nvalidate; 
END; 
BEGIN 
text] mage := TTextl mage( obj); 
IF textl mage. imageList.Size > 0 THEN 
text! mage. view. panel. OnAl | PadsDo(I nval OnPad); 
END; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. txtl mgList. Each(Invall ni mage); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TText. MarkChanged(textRange: TText Range) 


PROCEDURE Mark(obj: TObj ect); 
VAR textl mage: TTextl mage 
selection: TSelection; 
BEGIN 
selection := TTextl mage(obj).view. panel.sel ection; 
WHILE selection. coSelection <> NIL DO 
selection := selection. coSel ection; 
textl mage := TTextSelection(selection).textl mage 
WITH textRange DO 


{$H- } 
textl mage. MarkChanged(firstindex, firstLP, lastIndex, lastLP) 
{$H+} 
END; 
BEGIN 


{$lFC fTrace}BP( 10); {$ENDC} 
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SELF.txtl mgList. Each( Mark); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TText. Recomputel mages 
PROCEDURE Rel mage(obj: TObj ect); 
VAR textl mage: TTextl mage 
padCount: | NTEGER; 
numPads: INTEGER 


PROCEDURE | mageOnPad 
BEGIN 
padCount := padCount +1; 
{The first parameter in textl mage. Recomputel mages says we want to draw, but it wil 
call view. OKToDrawin to be sure its Okay 
The last parameter is TRUE when we are drawing on the last pad. Recomputel mages 
and DrawOrlnval will then set the valid bits on the images to TRUE} 
IF padCount = 1 THEN 
textl mage. Recomputel mages(actionDraw, (numPads = 1)) 
ELSE 
textl mage. DrawOrl nval (padCount = numPads); 


END; 
BEGIN 
textl mage := TTextl mage( obj ); 
numPads := textI mage. view. panel. panes. size 
padCount := 0; 
textl mage. view. panel. OnAl | PadsDo( I mageOnPad) ; 
END; 
BEGIN 


{$1FC fTrace}BP( 10); {$ENDC} 
SELF. txtl mgList. Each( Rel mage) ; 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ SgTxt Wrm} 

FUNCTION TText.SelectAll(textl mage: TTextIl mage): TTextSel ection; 

VAR |astPara: TEdit Para; 
textSel ection: TTextSel ection; 

BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
lastPara := TEditPara( SELF. paragraphs. Last); 
textSelection := textl mage. NewTextSelection(TEditPara(SELF. paragraphs. First), 1, 0, 

lastPara, SELF. paragraphs. Size, lastPara, size) 

SelectAll := textSelection; 
{$I1FC fTrace}EP; {$ENDC} 
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000428 END; 
000429 

000430 {$8 SgTxtI ni} 
000431 BEGIN 


000432 fTextTrace := FALSE; 

000433 END; {Methods of TText} 

000434 

000435 

000436 METHODS OF TTextI mage 

000437 

000438 {$8 SgTxtI ni} 

000439 FUNCTION TTextl mage. CREATE(object: TObject; heap: THeap; itsView: TView 
000440 itsLRect: LRect; itsText: TText; isGrowable: BOOLEAN): TTextl mage 
000441 VAR imgList: TList; 

000442 BEGIN 

000443 {$1FC fTrace}BP( 10); {$ENDC} 

000444 IF object = NIL THEN 

000445 object := NewObject(heap, THISCLASS) 

000446 SELF := TTextl mage(Tl mage. CREATE(object, heap, itsLRect, itsView)) 
000447 imgList := TList.CREATE(NIL, heap, 0) 

000448 

000449 WITH SELF DO 

000450 BEGIN 

000451 text := itsText; 

000452 imageList := imglist; 

000453 tickCount := 0; 

000454 growsDynamically := isGrowable; 

000455 mi nHei ght := itsLRect.bottom- itsLRect.top; 

000456 formerBottom:= itsLRect.top; 

000457 updateLRect := zeroLRect; 

000458 firstLinePixel := 0; 

000459 useFirstPixel := FALSE; 

000460 firstlndex := 1; 

000461 startLP := 0; 

000462 endLP := 0: 

000463 {app must set these properly if using multiple linked text images} 
000464 prevTxtl mg := NIL; 

000465 nextTxtl mg := NIL; 

000466 headTxtIl mg := SELF; 

000467 tail Txtlmg := SELF; 

000468 END; 

000469 {$I1FC fTrace}EP; {$ENDC} 

000470 END; 

000471 

000472 {$8 SgTxtCld} 

000473 {This frees all text images and their paralmages in the text image chain, 
000474 It does NOT free any paragraphs, text objects, or paraFormats. Call this only once 
000475 for each text image chain (NOT for each text image in the chain} 
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000476 PROCEDURE TTextl mage. Free 

000477 VAR textl mage: TTextl mage 

000478 next: TTextl mage; 

000479 BEGIN 

000480 {$1FC fTrace}BP( 10); {$ENDC} 

000481 IF SELF. headTxtl mg = SELF THEN 
000482 {Think about freeing text here if this is its only text image, but beware of circular frees} 
000483 BEGIN 

000484 textl mage := SELF; 

000485 WHILE textl mage <> NIL DO 
000486 BEGIN 

000487 textl mage. imageList.Free 
000488 next := textl mage. next Txtl mg 
000489 textl mage. FreeObj ect 
000490 textl mage := next; 
000491 END; 

000492 END 

000493 ELSE 

000494 SELF. headTxt! mg. Free 

000495 {$IFC fTrace}EP; {$ENDC} 

000496 END; 

000497 

000498 

000499 {$8 SgTxtCld} 

000500 {Frees just one text image in the chain; pays no attention to links} 
000501 PROCEDURE TTextl mage. FreeOneTextl mage 
000502 VAR textl mage: TTextl mage 

000503 next: TTextl mage; 

000504 BEGIN 

000505 {$1FC fTrace}BP( 10); {$ENDC} 

000506 SELF. imageList. Free 

000507 SELF. FreeObj ect; 

000508 {$1FC fTrace}EP; {$ENDC} 

000509 END; 

000510 

000511 

000512 


000513 {$8 SgTxtCld} 
000514 {$lFC fTextTrace} 


000515 PROCEDURE TTextl mage. Fields( PROCEDURE Field(nameAndType: $255) ) 
000516 BEGIN 

000517 SUPERSELF. Fi el ds( Fi el d) 

000518 Field('text: TText'); 

000519 Field('imageList: TList'); 

000520 Field('tickCount: | NTEGER' ) 

000521 Field('growsDynamically: BOOLEAN’ ) 

000522 Field(' mi nHeight: I NTEGER') 

000523 Field('formerBottom LONGI NT' ) 
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Field('updateLRect: LRect'); 
Field('firstLinePixel: LONGINT'); 
Field('useFirstPixel: BOOLEAN'); 
Field('firstindex: LONGINT'); 
Field('startLP: I NTEGER'); 
Field('endLP: I NTEGER'); 
Field('prevTxtl mg: TTextl mage'); 
Field('nextTxtl mg: TTextl mage'); 
Field('headTxtIl mg: TTextl mage'); 
Field('tailTxtIl mg: TTextl mage'); 
Field(''); 
END; 
{$ENDC} 


{$S SgTxtCld} 
PROCEDURE TTextl mage. Addl mage(paral mage: TParal mage); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. i mageList.InsLast(paral mage); 
{$I FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
PROCEDURE TTextl mage. Dell magesWth(del Para: TEditPara); 
VAR (* 
i,j: INTEGER; 
num mages: INTEGER; 
*) 


S! TListScanner: 
paral mage: TParal mage; 


BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
s := del Para. images. Scanner; 


WHILE s.Scan(paral mage) DO 
1F paral mage. text! mage. headTxtl mg = SELF. headTxt!l mg THEN 
BEGIN 
paral mage. text! mage. i mageList.Del Object(paral mage, FALSE); 
s. Del ete( FALSE); 
paral mage. Free; 


END; 
(* 
numl mages := del Para. Numl mages; 
jit; 
FOR i := 1 TO numl mages DO 
BEGIN 


{paral mage. Free calls paragraph. Dell mage which shifts rest 
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of images left so next image will always be at position j} 

paral mage := del Para.images[j]; 

1F paral mage. textl mage. headTxtl mg = SELF. headTxt!l mg THEN 
paral mage. textl mage. imageList.Del Object(paral mage, TRUE) 
E 


x 


{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Wrm} 
PROCEDURE TTextl mage. Draw 
PROCEDURE ReDraw( obj: TObject); 
BEGIN 
IF LRectlsVisible(TParal mage(obj).extentLRect) THEN 
TParal mage(obj).RedrawlLines(0, MAXINT); 
END; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
Pi cGrpBegi n; 
SELF. i mageList. Each(ReDraw) 
{Now tell the next textl mage in the chain to draw itself} 
IF SELF. nextTxtl mg <> NIL THEN 
SELF. next Txtl mg. Draw 


Pi cGrpEnd; 
{$I1FC fTrace}EP; {$ENDC} 
END; {Draw} 


{$$ SgTxtCld} 
PROCEDURE TTextl mage. Drawl mages(f Draw: BOOLEAN) 
PROCEDURE ReDraw( obj: TObject); 
BEGIN 
IF LRectlsVisible(TParal mage(obj).extentLRect) THEN 
TParal mage(obj).RedrawlLines(0, MAXINT); 
END; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. i mageList. Each( ReDraw) 
{Now tell the next textIl mage in the chain to draw itself} 
IF SELF. nextTxtl mg <> NIL THEN 
SELF. next Txt! mg. Drawl mages(f Draw); 
{$IFC fTrace}EP; {$ENDC} 
END; {Drawl mages} 
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{$$ SgTxtCld} 
PROCEDURE TTextl mage. DrawOrl nval(inval Bits: BOOLEAN); 
VAR f Draw: BOOLEAN 
ri LRect; 


PROCEDURE DrawFilt! mage(obj: TObj ect); 
VAR paral mage: TParal mage 


PROCEDURE Drawl mage(obj: TObj ect); 

VAR leftPixel: LONGI NT; 
rightPixel: LONGI NT; 
stylelndex: | NTEGER 


PROCEDURE DrawLine(obj: TObj ect); 
VAR linel nfo: TLi nel nfo 
dummy: INTEGER; 
BEGIN 
linelnfo := TLinel nfo( obj); 
1F NOT linelnfo. valid THEN 
BEGIN 
r := linelnfo.lineLRect; 
r.left := linelnfo.leftCoord(leftPixel); 
r.right := linelnfo.leftCoord(ri ght Pixel ) 
IF fDraw THEN 
BEGIN 
FillLRect(r, | Pat White); 
IF linelnfo.startLP <> linelnfo.lastDrawnLP THEN 
BEGIN 


MoveToL(linelnfo.lineLRect. left, linelnfo.lineLRect.toptlinelnfo.lineAscent); 
paral mage. FastDrawline(linelnfo.startLP, linelnfo.lastDrawnLP, TRUE, 


FALSE, dummy, styl elndex); 
END; 
END 
ELSE 
thePad. | nvalLRect(r); 
linelnfo. valid := inval Bits 
END; 
END; 


BEGIN 
IF paral mage. wasOffset THEN 
BEGIN 
{possibly use ScrollRect here later?} 
r := paralmage. extentLRect 
InsetLRect(r, -1, 0); 
1F fDraw THEN 
BEGIN 
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000668 FillLRect(r, | Pat White) 

000669 paral mage. Redrawlines(0, MAXI NT) 

000670 END 

000671 ELSE 

000672 thePad. I nvalLRect(r); 

000673 paral mage. wasOffset := NOT inval Bits 

000674 END 

000675 ELSE IF paral mage.changed THEN 

000676 BEGIN 

000677 leftPixel := paral mage. extentLRect.left-1; 
000678 right Pixel := paral mage. extentLRect. right +1; 
000679 stylelndex := 1; 

000680 paral mage.|ineList. Each( DrawLi ne); 

000681 paral mage.changed := NOT inval Bits 

000682 END; 

000683 END; 

000684 

000685 BEGIN 

000686 paral mage := TParal mage( obj); 

000687 SELF. FilterAndDo( paral mage, Drawl mage) 

000688 END; 

000689 

000690 BEGIN 

000691 {$IFC fTrace}BP( 10); {$ENDC} 

000692 f Draw := SELF. view. OKToDrawin(SELF.extentLRect) AND NOT deferUpdate 
000693 SELF. i mageList. Each( DrawFil tl mage) 

000694 

000695 1F NOT EmptyLRect(SELF.updateLRect) THEN 

000696 BEGIN 

000697 1F fDraw THEN 

000698 Fill LRect(SELF.updateLRect, | Pat White) 

000699 ELSE 

000700 thePad. I nval LRect(SELF.updateLRect); 

000701 IF inval Bits THEN 

000702 SELF.updateLRect := zeroLRect; 

000703 END; 

000704 {Now tell the next textIl mage in the chain to draw itself} 
000705 IF SELF. nextTxtl mg <> NIL THEN 

000706 SELF. next Txt! mg. DrawOrl nval (inval Bits); 

000707 {$I1FC fTrace}EP; {$ENDC} 

000708 END: 

000709 

000710 

000711 {$8 SgTxt Hot} 

000712 PROCEDURE TTextl mage. FindParaAndLp(|I Pt: LPoint; VAR paral mage: TParal mage 
000713 VAR paralndex: LONGINT; VAR aLP: INTEGER); 
000714 VAR distanceDown: INTEGER 

000715 S! TListScanner 
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000716 {$I FC fTextTrace} 

000717 str: STR255; 

000718 {$ENDC} 

000719 BEGIN 

000720 {$1FC fTrace}BP( 9); {$ENDC} 

000721 

000722 {It is assumed that the caller of this routine has already determined that I Pt is in this 
000723 textl mage, so we will not check nextTextI mg if the image list is exhausted} 

000724 distanceDown := SELF. extentLRect. top; 

000725 s := SELF.imageList. Scanner 

000726 WHILE s.Scan(paral mage) DO 

000727 BEGIN 

000728 distanceDown := distanceDown + paral mage. hei ght; 

000729 paralndex := s, Position; 

000730 IF IPt.v <= distanceDown THEN 

000731 s. Done; 

000732 END; 

000733 

000734 paralndex := paralndex + SELF.firstIndex - 1; 

000735 

000736 [F | Pt.v > distanceDown THEN 

000737 paral mage := TParal mage(SELF.imageList. Last); 

000738 

000739 aLP := paral mage. LpWthLPt(I Pt); 

000740 {$I FC fTextTrace} 

000741 IF fTextTrace THEN 

000742 BEGIN 

000743 Li ntToHex(ORD( paral mage), @str) 

000744 writeln('*** End FindParaAndLp: I Pt= (',I1Pt.v:4, ',', I Pt. h:4, '); paralmage, index, Ip = 
000745 str, ',', paralndex:1, ',', aLP:3, ')') 

000746 END; 

000747 {$ENDC} 

000748 {$1FC fTrace}EP; {$ENDC} 

000749 END; 

000750 

000751 

000752 

000753 {$8 SgTxt Hot} 

000754 FUNCTION TTextl mage. FindTextl mage( VAR mouseLPt: LPoint; VAR firstTxtIl mg: TTextl mage): TText! mage 
000755 VAR textl mage: TTextl mage 

000756 still Looking: BOOLEAN 

000757 foundit: BOOLEAN 

000758 BEGIN 

000759 {$1FC fTrace}BP( 9); {$ENDC} 

000760 {This looks around for a textl mage that contains the mouseLPt and has some images. If it 
000761 finds a textl mage that contains the point but does not have any images, then it 

000762 returns the first previous textl mage that does have some images and changes mouseLPt to be 
000763 the bottom right point of that textl mage 
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000764 If it doesn't find any textIl mages that contain the point it returns the first previous 
000765 textl mage that does have some images. Also, it returns which of the textl mages 
000766 (SELF or the found one) that comes first in the textl mage chain} 

000767 

000768 firstTxtl mg := SELF; 

000769 {Start with most common case and then try others} 

000770 IF (SELF.imageList.Size > 0) AND 

000771 (LPti nLRect(mouseLPt, SELF.extentLRect) OR SELF. growsDynamically) THEN 
000772 FindTextl mage := SELF 

000773 ELSE 

000774 BEGIN 

000775 textl mage := SELF; 

000776 still Looking := TRUE; 

000777 foundit := FALSE; 

000778 WHILE still Looking DO 

000779 BEGIN 

000780 {First look in following boxes} 

000781 IF LPtInLRect(mouseLPt, text!l mage. extentLRect) THEN 

000782 BEGIN 

000783 {if box found but no images in it, then link back} 

000784 WHILE (textIl mage <> textl mage. headTxtl mg) AND (textI mage.imageList.Size = 0) DO 
000785 BEGIN 

000786 textl mage := textl mage. prevTxtl mg; 

000787 mouseLPt := textl mage. extentLRect. bot Right; 

000788 END; 

000789 foundit := TRUE; 

000790 still Looking := FALSE; 

000791 END 

000792 ELSE IF textil mage. nextTxtl mg <> NIL THEN 

000793 textl mage := textl mage. next Txtl mg 

000794 ELSE still Looking : = FALSE; 

000795 END; 

000796 

000797 IF foundit THEN 

000798 FindTextl mage := textl mage 

000799 ELSE 

000800 {Still didn't find it? Look in previous boxes} 

000801 BEGIN 

000802 stillLooking := TRUE; 

000803 WHILE still Looking DO 

000804 BEGIN 

000805 IF LPtI nLRect(mouseLPt, textl mage.extentLRect) THEN 

000806 BEGIN 

000807 WHILE (textl mage <> textIl mage. headTxtlmg) AND (textI mage.imageList.Size = 0) DO 
000808 BEGIN 

000809 textl mage := textl mage. prevTxtl mg; 

000810 mouseLPt := textl mage. extentLRect. bot Ri ght; 

000811 END; 
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000812 foundit := TRUE; 

000813 still Looking := FALSE; 

000814 END 

000815 ELSE IF textil mage. prevTxti mg <> NIL THEN 

000816 textl mage := textl mage. prevTxtl mg 

000817 ELSE still Looking : = FALSE; 

000818 END; 

000819 1F foundit THEN 

000820 BEGIN 

000821 FindTextl mage := text! mage 

000822 firstTxtl mage := textl mage 

000823 END 

000824 ELSE 

000825 BEGIN 

000826 {mouseLPt didn't fall in any of the text images, so return SELF or the first previous 
000827 text image that has a parai mage} 

000828 textl mage := SELF; 

000829 WHILE (textIl mage <> textI mage. headTxtl mg) AND (textI mage.imageList.Size = 0) DO 
000830 BEGIN 

000831 textl mage := text! mage. prevTxtl mg 

000832 mouseLPt := textl mage. extentLRect. bot Ri ght; 

000833 END; 

000834 FindTextl mage := text! mage 

000835 END; 

000836 END; 

000837 END; 

000838 {$1FC fTrace}EP; {$ENDC} 

000839 END; 

000840 

000841 

000842 {$8 SgTxtHot} 

000843 PROCEDURE TTextl mage. Getl mageRange(firstIndex: LONGINT; VAR firstLP: INTEGER 
000844 lastindex: LONGINT; VAR lastLP: INTEGER 
000845 VAR firstl mage, lastIl mage: TParal mage) 
000846 

000847 {Diagram of input vs output: = characters not displayed by this textl mage chain; 
000848 Xxx = characters that are displayed by this textl mage chain; 
000849 

000850 «tee eee eee 000 0000000000000000000000000000 CREE 

000851 . . ‘ : s ny 

000852 1 2 3 4 5 6 7 

000853 

000854 

000855 input imageWth out put 

000856 1,2 N,N N,N 

000857 1,3 N, 3 N, 3 

000858 1,4 N,4 3,4 

000859 1,5 N,5 3,5 
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000860 1,6 N,N 3,5 

000861 3,3 3,3 3,3 N = NIL 

000862 3,4 3,4 3,4 

000863 4,5 4,5 4,5 

000864 4,6 4,N 4,5 

000865 5,5 5,5 5,5 

000866 5,6 5,N 5,N 

000867 6,7 N,N N,N 

000868 } 

000869 

000870 FUNCTION GetFirstOrLast(index: LONGINT; VAR |p: INTEGER): TParal mage 
000871 VAR paral mage: TParal mage 

000872 lastTxtl mg: TTextl mage 

000873 BEGIN 

000874 {$1 FC fTrace}BP( 10); {$ENDC} 

000875 IF (index < SELF. headTxtIl mg. firstilndex) OR 

000876 ((index = SELF. headTxtl mg.firstIndex) AND (Ip < SELF. headTxtl mg.startLP)) THEN 
000877 BEGIN 

000878 paral mage := TParal mage(SELF.headTxt! mg.imageList. First); 
000879 Ip := paral mage.startLP 

000880 END 

000881 ELSE 

000882 BEGIN 

000883 last Txtl mg := SELF. tail Txt! mg; 

000884 WHILE |astTxtIlmg.imageList.Size <= 0 DO 

000885 lastTxtlmg := lastTxtl mg. prevTxtl mg 

000886 paral mage := TParal mage(lastTxtl mg.imageList. Last); 
000887 Ip := paral mage. endLP 

000888 END; 

000889 GetFirstOrLast := paral mage 

000890 {$1 FC fTrace}EP; {$ENDC} 

000891 END; 

000892 BEGIN 

000893 {$1FC fTrace}BP( 10); {$ENDC} 

000894 firstl mage := SELF.| mageWth(TEditPara(SELF.text. paragraphs. At(firstIndex)), firstLP); 
000895 lastl mage := SELF. | mageWith(TEditPara(SELF. text. paragraphs. At(lastindex)), lastLP); 
000896 

000897 IF (firstlmage = NIL) OR (lastl mage = NIL) THEN 

000898 BEGIN 

000899 IF firstl mage = NIL THEN 

000900 IF lastl mage <> NIL THEN 

000901 BEGIN 

000902 firstl mage := GetFirstOrLast(firstI ndex, firstLP); 
000903 [IF (firstlmage = lastl mage) THEN 

000904 IF (firstLP = lastLP) THEN 

000905 firstl mage := NIL; 

000906 END 

000907 ELSE 
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000908 
000909 
000910 
000911 
000912 
000913 
000914 
000915 
000916 
000917 
000918 
000919 
000920 
000921 
000922 
000923 
000924 
000925 
000926 
000927 
000928 
000929 
000930 
000931 
000932 
000933 
000934 
000935 
000936 
000937 
000938 
000939 
000940 
000941 
000942 
000943 
000944 
000945 
000946 
000947 
000948 
000949 
000950 
000951 
000952 
000953 
000954 
000955 
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BEGIN 
firstl mage 
lastl mage 
IF (first! mage 
BEGIN 
firstl mage 
lastl mage 
END; 
END 
ELSE 
BEGIN 
lastl mage := GetFir 
IF (firstl mage = la 
IF (firstLP = | 
lastl mage 
END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TTextl mage. HiliteText 


LABEL 1: 

VAR startl mage: TParal mage 
endl mage: TParal mage; 
rm LRect; 
linel nfo: TLi nel nfo; 
paral mage: TParal mage 
simg, sViewSt: TListScanne 
startLine: INTEGER; 
endLi ne: INTEGER; 
startPixel: LONGI NT; 
endPi xel: LONGI NT; 
| MargPixel: LONGI NT; 
rMargPixel: LONGI NT; 
i: | NTEGER; 
textl mage: TTextl mage 
still Okay: BOOLEAN; 
{$IFC fTextTrace} 
str: STR255; 
stra: STR255; 
{$ENDC} 

BEGIN 


{$1 FC fTrace}BP( 10); {$ENDC} 
{$IFC fTextTrace} 


Apple Lisa To 


:= GetFirstOrLast(firstI ndex, 
r= GetFirstOrLast(lastl ndex 


firstLP); 
lastLP); 
= lastl mage) AND (firstLP = lastLP) THEN 


:= NIL; 


:= NIL; 


stOrLast(lastlindex, 
stl mage) THEN 
astLP) THEN 


lastLP); 


:= NIL; 


(highTransit: THighTransit; 


startIl ndex: LONGINT; startLP: INTEGER 
endindex: LONGINT; endLP: INTEGER; wholePara: BOOLEAN); 
ry 
{for debug output} 
{for debug output} 
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000956 IF fTextTrace THEN 

000957 BEGIN 

000958 Writeln('*** In HiliteText: [(', startIlndex:1, ',', startLP:1, ') , (', 
000959 endindex:1, ',', endLP:1, 

000960 ')]; highTransit = ', ORD(highTransit): 2); 

000961 Li ntToHex(ORD(SELF), @str1l) 

000962 WriteLn('*** SELF = ', stri, ' SELF.endLP=', SELF. endLP: 1) 

000963 END; 

000964 {$ENDC} 

000965 

000966 IF (startIlndex = endindex) AND (startLP = endLP) THEN 

000967 BEGIN 

000968 startl mage := SELF. | mageWth(TEditPara(SELF. text. paragraphs. At(startIndex)), startLP) 
000969 endl mage := startl mage 

000970 still Okay := startl mage <> NIL; 

000971 END 

000972 ELSE 

000973 BEGIN 

000974 SELF. Getl mageRange(startindex, startLP, endindex, endLP, startl mage, endl mage) 
000975 still Okay := (startl mage <> NIL) AND (endl mage <> NIL); 

000976 END; 

000977 

000978 IF still Okay THEN 

000979 BEGIN 

000980 textl mage := startl mage. textl mage 

000981 

000982 |MargPixel := textl mage.extentLRect.left - 1; 

000983 rMargPixel := textl mage. extentLRect. right + 1; 

000984 

000985 1F highTransit = hDimToOn THEN 

000986 BEGIN 

000987 SELF. HiliteText(hDi mToOff, startIl ndex, startLP, endindex, endLP, whol ePara) 
000988 highTransit := hOffToOn; 

000989 END 

000990 ELSE IF highTransit = hOffToDim THEN 

000991 BEGIN 

000992 SELF. HiliteText(hOffToOn, startIl ndex, startLP, endindex, endLP, whol ePara) 
000993 highTransit := hOnToDim 

000994 END; 

000995 

000996 IF highTransit <> hNone THEN 

000997 BEGIN 

000998 Set PenState(highPen[ highTransit]); 

000999 IF highTransit = hOnToDim THEN 

001000 PenMode(notPatBic); { hOnToDim => change background from black to gray } 
001001 

001002 slmg := textl mage.i mageList. Scanner 

001003 WHILE sl mg.Scan( paral mage) DO 
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001004 
001005 
001006 
001007 
001008 
001009 
001010 
001011 
001012 
001013 
001014 
001015 
001016 
001017 
001018 
001019 
001020 
001021 
001022 
001023 
001024 
001025 
001026 
001027 
001028 
001029 
001030 
001031 
001032 
001033 
001034 
001035 
001036 
001037 
001038 
001039 
001040 
001041 
001042 
001043 
001044 
001045 
001046 
001047 
001048 
001049 
001050 
001051 
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IF paralmage = startl mage THEN 
GOTO 1; 


1: 
paral mage. LocateLP(startLP, startLine, startPixel); 


sViewSt := paral mage.lineList. Scanner 
i := 0; 
REPEAT 
IF sViewSt. Scan(linelnfo) THEN 
i := itl; 
UNTIL i = startLine; 


r := linelnfo.lineLRect; 
1F wholePara THEN 
r.left := linelnfo.LeftCoord(| MargPi xel ) 


r.left := startPixel:; 
r.right := linelnfo. RightCoord(rMargPi xel); 
WHILE paralmage <> endl mage DO 
BEGIN 
WHILE sViewSt.Scan(linelnfo) DO 
BEGIN 
PaintLRect(r); 
{$l FC fTextTrace} 
IF fTextTrace THEN 
BEGIN 


WriteLn('*** Within HiliteText: about to paintLRect: : 
r.top:1,'),(', r.left:1,',',r.right:1,')]' ); 


LI nt ToHex(ORD( paral mage), @str1) 
WriteLn('*** current paral mage=',str1) 
END; 
{$ENDC} 
r := linelnfo.lineLRect; 
r.left := linelnfo.LeftCoord(|MargPixel); 
r.right := linelnfo. RightCoord(rMargPixel ) 
END; 
IF simg.Scan(paral mage) THEN 
sViewSt := paral mage. lineList. Scanner 
ELSE 
BEGIN 
textl mage := textl mage. next Txtl mage 
|MargPixel := textl mage. extentLRect.left-1; 
rMargPixel := textl mage. extentLRect. right +1; 
slmg := textl mage. i mageList. Scanner 
IF slmg.Scan( paral mage) THEN 
sViewSt := paral mage. lineList. Scanner 
END; 
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001052 
001053 
001054 
001055 
001056 
001057 
001058 
001059 
001060 
001061 
001062 
001063 
001064 
001065 
001066 
001067 
001068 
001069 
001070 
001071 
001072 
001073 
001074 
001075 
001076 
001077 
001078 
001079 
001080 
001081 
001082 
001083 
001084 
001085 
001086 
001087 
001088 
001089 
001090 
001091 
001092 
001093 
001094 
001095 
001096 
001097 
001098 
001099 


Apple Lisa Computer Technical Information 


END; 
paral mage. LocateLP(endLP, endLine, endPixel); 


IF startl mage <> endl mage THEN 


BEGIN 

PaintLRect(r); 

sViewSt := paral mage.lineList. Scanner; 

IF sViewSt. Scan(linelnfo) THEN 
BEGIN 
r := linelnfo.lineLRect; 
r.left := linelnfo.LeftCoord(| MargPixel); 
r.right := linelnfo. RightCoord(rMargPixel ) 
END; 

isr=sl; 

END: 


WHILE i <> endLine DO 
BEGIN 
PaintLRect(r); 
IF sViewSt. Scan(linelnfo) THEN 


BEGIN 
r := linelnfo.lineLRect; 
r.left := linelnfo.LeftCoord(|MargPixel); 
r.right := linelnfo. RightCoord(rMargPi xel ) 
END; 
i := il; 
END; 
1F wholePara THEN 
r.right := linelnfo. Ri ghtCoord(rMargPi xel ) 
ELSE 
BEGIN 


r.right := endPixel 
{Add extra pixel if this is insertion point} 
IF (startl mage = endl mage) AND (startLP = endLP) THEN 
r.right :=r.right + 1; 
END; 
PaintLRect(r); 


Free(sViewSt); 
Free(sl mg); 


1F highTransit = hDimToOff THEN { XORing out gray leaves holes in chars } 
BEGIN 


{later, we'll minimize this, if necessary} 
SELF. Draw; { so redraw characters } 
END; 


END; 
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001100 END 

001101 ELSE 

001102 BEGIN 

001103 {$1 FC fTextTrace} 

001104 [F fTextTrace THEN 

001105 BEGIN 

001106 Writeln('*** In HiliteText: Images NIL (DID NOT HILITE))'); 
001107 END; 

001108 {$ENDC} 

001109 END; 

001110 {$I1FC fTrace}EP; {$ENDC} 

001111 END; {HiliteText} 

001112 

001113 

001114 {$8 SgTxt Hot} 

001115 {Given a paragraph and Ip finds the paralmage that displays it in this textl mage chain. 
001116 Returns NIL if not found. } 

001117 FUNCTION TTextI mage.| mageWith( paragraph: TEditPara; |p: INTEGER): TParal mage 
001118 VAR paral mage: TParal mage 

001119 al tParal mage: TParal mage 

001120 S! TListScanner; 

001121 (* 

001122 ie | NTEGER; 

001123 *) 

001124 {$IFC fTextTrace} 

001125 str: STR255; 

001126 {$ENDC} 

001127 BEGIN 

001128 {$1 FC fTrace}BP( 9); {$ENDC} 

001129 {$IFC fTextTrace} 

001130 [F fTextTrace THEN 

001131 BEGIN 

001132 LI ntToHex(ORD( paragraph), @str) 

001133 WriteLn('$$$ In ImageWth: paragraph,]p = (',str, ',', Ip:1, ')' ); 
001134 END; 

001135 {$ENDC} 

001136 

001137 altParalmage := NIL; 

001138 S$ := paragraph. images. Scanner 

001139 WHILE s.Scan(paral mage) DO 

001140 IF (( paral mage. textl mage. headTxtl mg = SELF. headTxtIlmg) AND 
001141 (paralmage.startLP <= 1p) AND 

001142 (Ip <= paralmage.endLP)) THEN 

001143 IF |p = paral mage. endLP THEN 

001144 IF paral mage.textl mage <> SELF THEN 

001145 altParal mage := paral mage 

001146 ELSE 

001147 s. Done 
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001148 
001149 
001150 
001151 
001152 
001153 
001154 
001155 
001156 
001157 
001158 
001159 
001160 
001161 
001162 
001163 
001164 
001165 
001166 
001167 
001168 
001169 
001170 
001171 
001172 
001173 
001174 
001175 
001176 
001177 
001178 
001179 
001180 
001181 
001182 
001183 
001184 
001185 
001186 
001187 
001188 
001189 
001190 
001191 
001192 
001193 
001194 
001195 
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ELSE 
s. Done; 


IF paralmage = NIL THEN 
paral mage := altParal mage; 
(* 


jet 
WITH paragraph DO 


WHILE (i <= numl mages) DO 
IF ((images[i].textl mage. headTxtl mg = SELF. headTxtl mg) AND 
(images[i].startLP <= |p) AND 
(Ip <= images[i].endLP)) THEN 
BEGIN 
paral mage := images[i]; 
i := MAXINT; 
END 
ELSE 


i ent eds 
{$1 FC fRngText }{$R+}{$ENDC} 
*) 


{$I1FC fTextTrace} 
IF fTextTrace THEN 
BEGIN 
LI ntToHex(ORD( paral mage), @str) 
WriteLn('$$$ In ImageWth: paral mage found= ',str); 


END; 
{$ENDC} 
ImageWith := paral mage 
{$I FC fTrace}EP; {$ENDC} 


END; 


{$$ SgTxtHot } 
FUNCTION TTextl mage. |! mageBottom: LONGI NT; 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
[F SELF.imageList.Size > 0 THEN 
ImageBottom:= TParal mage(SELF.imageList.Last).extentLRect. bottom 
ELSE 
ImageBottom:= SELF. extentLRect. top; 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
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001196 
001197 
001198 
001199 
001200 
001201 
001202 
001203 
001204 
001205 
001206 
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001208 
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001213 
001214 
001215 
001216 
001217 
001218 
001219 
001220 
001221 
001222 
001223 
001224 
001225 
001226 
001227 
001228 
001229 
001230 
001231 
001232 
001233 
001234 
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001236 
001237 
001238 
001239 
001240 
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001242 
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PROCEDURE TText! mage.| nsertNewPara(existingPara, newPara: TEditPara) 


VAR paral mage: TParal mage; 
last! mage: TParal mage; 
newParal mage: TParal mage 
textl mage: TTextl mage 
{$1FC fTextTrace} 
str: STR255; 
{$ENDC} 

BEGI N 


{$1FC fTrace}BP( 10); {$ENDC} 
{Try to find the image with the proper Ip, but, failing that, see if there is any image that 
points to existingPara} 
paral mage := SELF.| mageWith(existingPara, existingPara.size - 1) 
IF paralmage = NIL THEN 
paral mage := SELF.| mageWth(existingPara, 0) 
IF paralmage = NIL THEN 
BEGIN 
{$1 FC fTextTrace} 
[F fTextTrace THEN 
BEGIN 
Li nt ToHex( ORD(existingPara), @str) 
WriteLn(' @@@ In InsertNewPara: existingPara = (',str,')' ); 
WriteLn('@@@ ImageWth returned NIL!!'); 
END; 
{$ENDC} 
END 
ELSE 
BEGIN 
textl mage := paral mage. textl mage 
lastl mage := TParal mage(textl mage.imageList. Last); 
newParal mage := text! mage. NewParal mage(newPara, paralmage.extentLRect, 0, 0); 
textl mage.imageList.InsAt(textl mage. imageList.Pos(0, paralmage) + 1, newParal mage) 


{If we inserted the new paral mage at the end of the current image list and if the 
last paragraph was previously split between two or more paral mages, then set the paragraph 
field in the first image of the next text image to the new paragraph, and adjust the 
paragraphs’ images accordingly} 

[F (paralmage = |astil mage) THEN 

BEGIN 
textl mage := paral mage. textl mage. next Txtl mg 
WHILE (textIlmage <> NIL) DO 
IF textl mage. imageList. Size > 0 THEN 
BEGIN 
paral mage := TParal mage(textl mage. i mageList. First); 
[F paral mage. paragraph = |astl mage. paragraph THEN 


BEGIN 
paral mage. paragraph := newPara; 
newPara.|nslI mage( paral mage); {|} 
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001244 lastl mage. paragraph. Dell mage(paral mage, FALSE); {|} 
001245 textl mage := textl mage. next Txtl mg; 
001246 END 

001247 ELSE 

001248 textl mage := NIL 
001249 END 

001250 ELSE 

001251 textl mage := NIL 
001252 END; 

001253 END; 

001254 {$I1FC fTrace}EP; {$ENDC} 

001255 END; 

001256 

001257 

001258 {$8 SgTxtCld} 

001259 PROCEDURE TTextl mage. I nval All; 

001260 VAR r: LRect; 

001261 textl mage: TTextl mage; 

001262 

001263 PROCEDURE Inval(obj: TObj ect); 
001264 BEGIN 

001265 TParal mage(obj).I nvalLinesWith(0, MAXINT); 
001266 END; 

001267 BEGIN 

001268 {$1 FC fTrace}BP(10); {$ENDC} 

001269 textl mage := SELF. headTxt! mg; 

001270 WHILE textIl mage <> NIL DO 

001271 BEGIN 

001272 textl mage.i mageList. Each(Inval); 
001273 r := textl mage. extentLRect; 
001274 InsetLRect(r, -1, 0); 

001275 SELF. view. panel. | nvalLRect(r); 
001276 textl mage := textl mage. next Txt! mg; 
001277 END; 

001278 {$I1FC fTrace}EP; {$ENDC} 

001279 END; 

001280 

001281 

001282 {$8 SgTxtCld} 

001283 PROCEDURE TTextl mage. I nvalidate; 

001284 VAR r: LRect; 

001285 s, sLine: TListScanner; 

001286 paral mage: TParal mage; 

001287 linelnfo: TLi nel nfo; 

001288 BEGIN 

001289 {$1 FC fTrace}BP( 10); {$ENDC} 

001290 s := SELF.imageList. Scanner; 

001291 WHILE s.Scan(paral mage) DO 
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001292 
001293 
001294 
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001302 
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001336 
001337 
001338 
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IF paral mage. wasOffset THEN 
BEGIN 
r := paral mage. extentLRect; 
InsetLRect(r, -1, 0); 
thePad. I nvalLRect(r); 
paral mage. wasOffset := FALSE; 
paral mage. changed := FALSE; 
END 

ELSE IF paral mage. changed THEN 
BEGIN 


paral mage.changed := FALSE; 
sLine := paral mage. lineList. Scanner 
WHILE sLine.Scan(linelnfo) DO 
1F NOT linelnfo.valid THEN 
BEGIN 
linelnfo. valid := TRUE; 
r := linelnfo.lineLRect; 
r.left := paral mage, extentLRect. left; 
r.right := paralmage.extentLRect. right; 
InsetLRect(r, -1, 0); 
thePad. I nvalLRect(r); 
END; 
END; 


1F NOT EmptyLRect(SELF.updateLRect) THEN 
BEGIN 
thePad. I nval LRect(SELF. updateLRect); 
SELF. updateLRect := zeroLRect; 
END; 


IF SELF. nextTxtl mg <> NIL THEN 
SELF. next Txtl mg. | nvalidate; 


{$I1FC fTrace}EP; {$ENDC} 


{$$ SgTxt Hot} 

PROCEDURE TTextl mage. MarkChanged(startindex: LONGINT; startLP: | NTEGER 
endindex: LONGINT; endLP: 
VAR sli mg: TListScanner 


firstl mage: TParal mage 
lastl mage: TParal mage 
paral mage: TParal mage 
found: BOOLEAN; 
finished: BOOLEAN 
textl mage: TTextl mage 
tempLP: INTEGER; 
still Okay: BOOLEAN 


INTEGER) ; 
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001340 BEGIN 

001341 {$1FC fTrace}BP( 10); {$ENDC} 

001342 still Okay := TRUE; 

001343 IF (startlndex = endindex) AND (startLP = endLP) THEN 
001344 BEGIN 

001345 firstl mage := SELF.| mageWth(TEditPara(SELF.text. paragraphs. At(startIndex)), startLP); 
001346 lastl mage := first! mage; 

001347 still Okay := firstl mage <> NIL; 

001348 END 

001349 ELSE 

001350 BEGIN 

001351 SELF. Getl mageRange(startindex, startLP, endindex, endLP, firstI mage, | astl mage); 
001352 IF firstl mage = NIL THEN 

001353 IF lastl mage = NIL THEN 

001354 still Okay := FALSE 

001355 ELSE 

001356 BEGIN 

001357 firstl mage := lastl mage; 

001358 startLP := endLP; 

001359 END 

001360 ELSE IF lastl mage = NIL THEN 

001361 BEGIN 

001362 lastl mage := firstl mage; 

001363 endLP := startLP: 

001364 END; 

001365 END; 

001366 

001367 IF still Okay THEN 

001368 BEGIN 

001369 IF firstl mage = |astl mage THEN 

001370 firstlmage.InvalLinesWth(startLP, endLP) 
001371 ELSE 

001372 BEGIN 

001373 textl mage := firstl mage.textl mage; 

001374 found := FALSE; 

001375 finished := FALSE; 

001376 WHILE NOT finished AND (textIl mage <> NIL) DO 
001377 BEGIN 

001378 slmg := textl mage. imageList. Scanner; 
001379 WHILE slmg.Scan(paral mage) DO 

001380 BEGIN 

001381 found := found OR (paral mage = firstl mage); 
001382 1F found THEN 

001383 BEGIN 

001384 IF paralmage = lastl mage THEN 
001385 BEGIN 

001386 tempLP := endLP; 

001387 finished := TRUE; 
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001388 sl mg. Done; 

001389 END 

001390 ELSE 

001391 tempLP := paral mage. endLP; 

001392 paral mage. I nvalLinesWth(startLP, tempLP); 

001393 startLP := 0; 

001394 END; 

001395 END; 

001396 text] mage := textl mage. next Txtl mg; 

001397 END; 

001398 END; 

001399 END; 

001400 {$1FC fTrace}EP; {$ENDC} 

001401 END; 

001402 

001403 

001404 {$8 SgTxtHot} 

001405 PROCEDURE TTextl mage. MousePress(mouseLPt: LPoint); 

001406 VAR currParal mage: TParal mage 

001407 currLP: INTEGER; 

001408 textl mage: TTextl mage 

001409 firstTxtl mg: TTextl mage 

001410 selection: TSelecti on; 

001411 paral ndex: LONGI NT; 

001412 

001413 BEGIN 

001414 {$I1FC fTrace}BP( 10); {$ENDC} 

001415 selection := SELF. view. panel.selection; 

001416 WHILE selection. coSelection <> NIL DO 

001417 selection := selection. coSelecti on; 

001418 IF (clickState.fShift OR (clickState.clickCount > 1)) AND InClass(selection, TTextSelection) THEN 
001419 { let the selection extend itself } 

001420 selection. MousePress( mouseLPt ) 

001421 ELSE 

001422 BEGIN 

001423 textl mage := SELF. FindTextl mage(mouseLPt, firstTxtl mg) 

001424 textl mage. FindParaAndLp( mouseLPt, currParal mage, paralndex, currLP) 
001425 

001426 {lf we are a coSelection then BeginSelection should already have been called when 
001427 panel selection was created} 

001428 |F SELF. view. panel.selection.coSelection = NIL THEN 

001429 SELF. view. panel. BeginSelection 

001430 ELSE 

001431 selection. Highlight ( hOnToOff) 

001432 

001433 selection := selection. FreedAndRepl acedBy( Ti nserti onPoi nt. CREATE( NIL, 
001434 SELF.Heap, SELF. view, textl mage, mouseLPt, 
001435 currParal mage. paragraph, paralndex, currLP)); 


Apple Lisa ToolKit 3.0 Source Code Listing -- 839 of 1012 


001436 
001437 
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001439 
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001483 


{$8 


{$8 


{$8 


{$8 


Apple Lisa Computer Technical Information 


SELF. text. ChangeSellnOtherPanels(TTextSelection(selection)); 
SELF.text.HiliteParagraphs(hOffToOn, paralndex, currLP, paralndex, currLP, FALSE); 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
FUNCTION TTextI mage. NewEditPara(initialSize: | NTEGER; itsFormat: TParaFormat): TEditPara; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
NewEditPara := TEditPara. CREATE(NIL, SELF. Heap, initialSize, itsFormat) 
{$SIFC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
FUNCTION TTextl mage. NewParal mage(itsParagraph: TEditPara; itsLRect: LRect; 
lineTop: LONGINT; lineLeft: LONGINT): TParal mage; 
VAR paral mage: TParal mage 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 


paral mage := TParal mage. CREATE(NIL, SELF.Heap, SELF.view, itsParagraph, itsLRect, lineTop, lineLeft); 


paral mage.textl mage := SELF; 
itsParagraph. Insl mage( paral mage); 


NewParal mage := paral mage 
{$IFC fTrace}EP; {$ENDC} 
END; 
SgTxt Cl d} 


FUNCTION TTextl mage. NewTextl mage( heap: THeap; itsView: TView; itsLRect: LRect 
itsText:TText; isGrowable: BOOLEAN): TTextl mage 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
NewTextl mage := TTextl mage. CREATE(NIL, heap, itsView, itsLRect, itsText, isGrowabl e) 
{$SIFC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 

FUNCTION TTextI mage. NewTextSelection(firstPara: TEditPara; firstIlndex: LONGINT; firstLP: INTEGER 
lastPara: TEditPara; lastIl ndex: LONGINT; I|astLP: INTEGER 
): TTextSel ection: 


VAR textSel: TText Selection; 
heap: THeap; 
view: TVi ew; 

BEGIN 
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001484 {$1FC fTrace}BP( 10); {$ENDC} 

001485 heap := SELF. Heap; 

001486 view := SELF. view 

001487 IF firstPara = lastPara THEN 

001488 IF firstLP = lastLP THEN 

001489 textSel := TinsertionPoint. CREATE(NIL, heap, view, SELF, zeroLPt, 
001490 firstPara, firstIindex, firstLP) 
001491 ELSE 

001492 textSel := TOneParaSelection, CREATE(NIL, heap, view, SELF, zeroLPt, 
001493 firstPara, firstIindex, firstLP, lastLP) 
001494 ELSE 

001495 textSel := TMultiParaSelection, CREATE(NIL, heap, view, SELF, zeroLPt, 
001496 firstPara, firstIndex, firstLP 
001497 lastPara, lastIlndex, lastLP, TRUE) 
001498 NewTextSelection := textSel 

001499 {$I1FC fTrace}EP; {$ENDC} 

001500 END: 

001501 

001502 

001503 {$8 SgTxtCld} 

001504 PROCEDURE TTextl mage. OffsetBy(deltaLPt: LPoint); 

001505 { Can be used to quickly move a text image } 

001506 PROCEDURE Offset! mage(obj: TObj ect); 

001507 BEGIN 

001508 TParal mage( obj). OffsetBy(deltaLPt); 

001509 END; 

001510 BEGIN 

001511 {$I1FC fTrace}BP( 10); {$ENDC} 

001512 WITH deltaLPt DO 

001513 {$H-} OffsetLRect(SELF.extentLRect, h, v); {$H+} 

001514 SELF. i mageList. Each(Offsetl mage); 

001515 {$I1FC fTrace}EP; {$ENDC} 

001516 END; 

001517 

001518 

001519 {$8 SgTxt Hot} 

001520 PROCEDURE TTextl mage. Recomputel mages(drawAction: TDrawAction; inval Bits: BOOLEAN) 
001521 LABEL 1; 

001522 VAR drawLRect: LRect; 

001523 lastLP: INTEGER; 

001524 last Drawnl mage: TParal mage 

001525 next Txtl mg: TTextl mage 

001526 paral mage: TParal mage 

001527 S! TListScanner 

001528 tempList: TList; 

001529 begi nAtLP: INTEGER 

001530 returnLRect: LRect; 

001531 lastl mage: TParal mage 
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001532 firstl mage: TParal mage; 

001533 last OneChanged: BOOLEAN; 

001534 deltaLPt: LPoint; 

001535 currParalndex: LONGI NT; 

001536 paragraph: TEdit Para; 

001537 newBottom: LONGI NT; 

001538 real Action: TDrawActi on: 

001539 ri LRect; 

001540 {$I FC fTextTrace} 

001541 str: STR255; 

001542 {$ENDC} 

001543 

001544 FUNCTION Onl yPartDrawn( pl mage: TParal mage): BOOLEAN; 

001545 VAR wontFit: BOOLEAN; 

001546 sLine: TListScanner; 

001547 deleteRest: BOOLEAN; 

001548 li nel nfo: TLi nel nf 0; 

001549 

001550 PROCEDURE DrawPl mage( obj: TObj ect); 

001551 VAR action: TDrawActi on: 

001552 bits: BOOLEAN; 

001553 BEGIN 

001554 {$1 FC fTrace}BP( 10); {$ENDC} 

001555 bits := inval Bits; 

001556 action := real Action; 

001557 {lf the paragraph was offset, we don't want DrawPara to draw the changed lines, so 
001558 we display the offset paragraph case below and pass actionNone to DrawPara. 
001559 However, we must pass FALSE for inval Bits since we still need the wasOffset flag 
001560 set for the display code bel ow} 

001561 IF pl mage. wasOffset THEN 

001562 BEGIN 

001563 action := actionNone: 

001564 bits := FALSE; 

001565 END; 

001566 pl mage. DrawParal mage(drawlRect, beginAtLP, action, bits, returnLRect); 
001567 {$I FC fTrace}EP; {$ENDC} 

001568 END; 

001569 BEGIN 

001570 {$1 FC fTrace}BP( 10); {$ENDC} 

001571 wontFit := FALSE: 

001572 lastOneChanged := FALSE; 

001573 pl mage.textl mage := SELF; 

001574 {$l FC fTextTrace} 

001575 |F fTextTrace THEN 

001576 BEGIN 

001577 LI nt ToHex(ORD( pl mage), @str); 

001578 WriteLn('++ Entering OnlyPartDrawn: plmage =', str); 

001579 WriteLn(' ++ : deltaLPt.v =', deltaLPt.v:1, ' drawlRect.top =', 
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drawLRect.top:1); 
END; 
{$ENDC} 


{offset plmage before recalculating so that unchanged linelnfo's get offset} 
IF drawLRect.top <> plmage.extentLRect.top THEN 
BEGIN 
deltaLPt.v := drawLRect.top - plmage.extentLRect. top; 
pl mage. Offset By(deltaLPt); 
pl mage. wasOffset := TRUE; {so that we know what to redraw/invalidate} 
{lf we moved the last paralmage up, maybe more will fit, so force call to DrawPara 
by setting changed TRUE} 
IF (deltaLPt.v < 0) AND (pl mage = SELF.imageList.Last) THEN 


BEGIN 
last OneChanged := TRUE; 
pl mage. changed := TRUE; 


END; 


IF plmage.changed THEN 
BEGIN 
lastLP := pl mage. endLP 
{$I FC fTextTrace} 
IF fTextTrace THEN 
WriteLn('++ OnlyPartDrawn: plmage changed, about to call DrawPara; old endLP =' 
lastLP: 1); 
{$ENDC} 


SELF. FilterAndDo( pl mage, DrawPl mage); 
{$I FC fTextTrace} 


|F fTextTrace THEN 
WriteLn('++ OnlyPartDrawn: DrawPara just called; plmage.endLP =' 


pl mage. endLP:1, ' para size = ', pl mage. paragraph. size: 1) 
{$ENDC} 
lastOneChanged := |astOneChanged OR (pl mage.endLP <> l|astLP) 
END 
ELSE IF deltaLPt.v > 0 THEN 
BEGIN 
{$I FC fTextTrace} 
|F fTextTrace THEN 
WriteLn('++ OnlyPartDrawn: plmage.extentLRect. bottom =', pl mage. extentLRect. bottom: 1, 
' drawlRect. bottom = ', drawLRect. bottom: 1) 
{$ENDC} 
wontFit := plmage.extentLRect. bottom > drawLRect. bottom 
1F wontFit THEN 
BEGIN 
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{Ideally, if textl mages are same width, just insert extra linelnfo's 
into first paralmage of next textl mage; If they are not same width, we 


still insert them but mark theminvalid. For now just delete them} 
lastOneChanged := TRUE; 
sLine := plmage.lineList. Scanner; 


deleteRest := FALSE; 
WHILE sLine.Scan(linelnfo) DO 
IF deleteRest THEN 
sLine. Del et e( TRUE) 
ELSE IF linelnfo.lineLRect. bottom > drawLRect. bottom THEN 
BEGIN 
{lf the first linelnfo won't fit then set plmage.endLP to -1, indicating that 
none of the paragraph fit} 
IF sLine. Position = 1 THEN 
BEGIN 
sLine. Done; 
pl mage. endLP := -1; 
END 
ELSE 
BEGIN 
pl mage. extentLRect. bottom:= linelnfo.lineLRect.top 
pl mage. endLP := linelnfo.startLP 
sLine. Del ete( TRUE); 
deleteRest := TRUE; 
END; 
END; 
END; 
END; 


drawLRect.top := pl mage. extentLRect. bottom 
lastLP := pl mage. endLP; 
wontFit := wontFit OR (pl mage.endLP <> pl mage. paragraph. size); 
IF plmage.wasOffset AND (lastLP >= 0) THEN 
BEGIN 
r := plmage,extentLRect; 
InsetLRect(r, -1, 0); 
IF real Action = actionDraw THEN 
BEGIN 
FillLRect(r, | Pat White); 
pl mage. RedrawLines(0, MAXINT); 
END 


ELSE IF realAction = actionlnval THEN 
thePad. Inval LRect(r); 

pl mage. wasOffset := NOT inval Bits 

pl mage. changed := FALSE; 

E 


{after the first paragraph is drawn, reset begi nAtLP} 
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beginAtLP := 0; 
1F NOT wontFit THEN 
currParalndex := currParalndex + 1; 
{$I FC fTextTrace} 
IF fTextTrace THEN 
WriteLn('++ EXITING OnlyPartDrawn: deltaLPt.v 
{$ENDC} 


{return TRUE when a paragraph does not get completely displayed} 


Onl yPartDrawn := wontFit; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


BEGIN {Recomputel Mages} 


{$1FC fTrace}BP( 10); {$ENDC} 
IF SELF = SELF. headTxtl mg THEN 
SELF. SetFirstI ndex; 
currParalndex := SELF. firstI ndex 
drawLRect := SELF.extentLRect; 
[F SELF. growsDynamically THEN 
drawLRect. bottom: = SELF. view. extentLRect. bottom 
real Action := drawAction; 
IF drawAction = actionDraw THEN 


IF NOT SELF. view. OKToDrawi n(drawlLRect) OR deferUpdate THEN 


realAction := actionlnval 


begi nAtLP := SELF. startLP 
deltaLPt := zeroLPt 


deltaLPt.v:1, 


wontFit = ', wontFit); 


{Recompute paragraphs until we reach the end of our imageList or no more will fit} 


{Use GOTO so we can hold on to the scanner if needed} 
s := SELF.imageList. Scanner 
WHILE s.Scan(lastDrawnl mage) DO 
1F Onl yPartDrawn(lastDrawnl mage) THEN 
GOTO 1; 


1: 
{$IFC fTextTrace} 
1F fTextTrace THEN 


BEGIN 
LI nt ToHex(ORD(lastDrawnl mage), @str) 


WriteLn('++ Recomputel mages: Just fell out of OnlyPartDrawn | oop: 
str, ' lastOneChanged=', | ast OneChanged); 


END; 
{$ENDC} 


last Drawnl mage=', 


{At this point, lastDrawnl mage will be NIL iff the scan went through the entire list 
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and OnlyPartDrawn never returned TRUE} 


{Hence, if lastDrawnl mage is NIL, then we displayed all our paralmages and there may 

still be some space left, so steal the next textlmage's paralmages (if any). Continue 

this in the Repeat loop until we use up the space or exhaust the paralmages. Note that we 
don't need to check nextTxtIl mg if none of the paralmages changed and had to be recalculated} 
next Txtl mg := SELF. next Txtl mg 

IF lastDrawnl mage = NIL THEN 


BEGIN 
IF lastOneChanged OR TRUE THEN {<-- temporary!!??} 
REPEAT 
IF nextTxtl mg <> NIL THEN 
BEGIN 
s := nextTxtl mg.imageList. Scanner; 


{Delete the first paralmage in the next textIl mage if it pointed to the same 
paragraph as the current textIl mage's last paralmage, since, if we got to 
this point, we must have already displayed the whole paragraph} 

IF (nextTxtlmg.imageList.Size > 0) AND (SELF.imageList.Size > 0) THEN 

BEGIN 
firstl mage := TParal mage(nextTxtl mg. i mageList. First); 
lastl mage := TParal mage(SELF.i mageList.Last); 
IF firstl mage. paragraph = lastl mage. paragraph THEN 
IF s.Scan( paral mage) THEN 
BEGIN 
paral mage. paragraph. images. Del Obj ect( paral mage, FALSE) 
s. Del et e( TRUE) ; 


END; 
END; 
WHILE s.Scan(lastDrawnl mage) DO 
BEGIN 


last Drawnl mage. I nval LinesWith(0, MAXI NT) 

deltaLPt.v := 0 

IF Onl yPartDrawn(lastDrawnl mage) THEN 
BEGIN 
{if we didn't stop between paragraphs, install the paralmage in our list, 
replace the next textlmage's first paralmage with a copy of this one 
then terminate the scan. Note that the extentLRect and 
height fields of the next Textlmage's first paral mage are now incorrect 
but will be rectified when nextTxtI mg. Recomputel mage is called} 
[F (lastLP >= 0) THEN 


BEGIN 
SELF. i mageList.InsLast(lastDrawnl mage) 
paral mage := nextTxtl mg. NewParal mage(l ast Drawnl mage. paragraph, 


lastDrawnl mage.extentLRect, 0, 0) 
s. Repl ace(paral mage, FALSE); 
END; 
s. Done; 
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END 
ELSE 
BEGIN 
{remove |astDrawnl mage from nextTxtIl mg.imageList and install in 
SELF. i mageLi st } 
s. Del ete( FALSE); 
SELF. i mageList. I nsLast(lastDrawnl mage); 
END; 
END; 
IF lastDrawnl mage = NIL THEN 
nextTxtl mg := nextTxtl mg. next Txt! mg; 
END; 
UNTIL (lastDrawnl mage <> NIL) OR (nextTxtIlmg = NIL) 


IF lastDrawnl mage = NIL THEN 
BEGIN 
{We exhausted all of the images and there is still potentially some room, so 
look at the paragraph list and see if there are some paragraphs for which no 
paralmages have yet been generated 
NOTE: this is where initial imaging of text without paralmages will be routed} 
[F currParalndex <= SELF.text.paragraphs. Size THEN 
BEGIN 
s := SELF. text. paragraphs. ScannerFromcurrParalndex-1, scanForward); 
WHILE s.Scan(paragraph) DO 
BEGIN 
lastDrawnl mage := SELF.NewParal mage(paragraph, drawLRect, 0, 0); 
IF Onl yPart Drawn(lastDrawnl mage) THEN 
s. Done; 
1F lastdrawnl mage.endLP >= 0 THEN 
SELF.imageList.InsLast(lastDrawnl mage) 
ELSE 
BEGIN 
last Drawnl mage. paragraph. images. Del Obj ect(lastDrawnl mage, TRUE) 
lastDrawnl mage := NIL; 
END; 
END; 
END; 
END; 
END 
ELSE IF nextTxtl mg <> NIL THEN 
BEGIN 
IF last OneChanged THEN 
BEGIN 
{we stopped displaying in the middle of a paragraph, so give the rest of our 
paralmages to the next textl mage (note that the scanner (s) is still valid 
because we jumped out of scan loop above) } 
{put rest of SELF.imageList paralmages in tempList, then insert tempList into nextTxtl mg} 
tempList := TList.CREATE(NIL, SELF.Heap, 0) 
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001820 {if we didn't display any of the current paralmage then delete it fromthis list} 
001821 IF lastLP < 0 THEN 

001822 BEGIN 

001823 {$I FC fTextTrace} 

001824 IF fTextTrace THEN 

001825 BEGIN 

001826 LI nt ToHex(ORD(| astDrawnl mage), @str); 

001827 WriteLn('++ Recomputel mages: lastLP < 0; lastdrawnlmage=', str); 
001828 END; 

001829 {$ENDC} 

001830 s. Del ete( FALSE); 

001831 paral mage := lastDrawnl mage; 

001832 paral mage.endLP := 0; 

001833 END 

001834 ELSE 

001835 BEGIN 

001836 paral mage := nextTxtl mg. NewParal mage(| ast Drawnl mage. paragraph, 
001837 lastDrawnl mage.extentLRect, 0, 0); 
001838 {$I FC fTextTrace} 

001839 [F fTextTrace THEN 

001840 BEGIN 

001841 LI ntToHex(ORD( paral mage), @str); 

001842 WriteLn('++ Recomputel mages: copy of lastDrawnl mage =', str); 
001843 END; 

001844 {$ENDC} 

001845 END; 

001846 tempList. I nsLast( paral mage) ; 

001847 {put the paralmages into tempList in reverse order so that we can scan it and insert 
001848 the images at the beginning of nextTxtIl mg.imageList (a double-reverse) } 
001849 WHILE s.Scan(paral mage) DO 

001850 BEGIN 

001851 {$I FC fTextTrace} 

001852 IF fTextTrace THEN 

001853 BEGIN 

001854 LI nt ToHex(ORD( paral mage), @str); 

001855 WriteLn('++ Recomputel mages: appending to tempList and deleting from SELF plmg=', str); 
001856 END; 

001857 {$ENDC} 

001858 tempList.InsFirst( paral mage) ; 

001859 s. Del ete( FALSE); 

001860 END; 

001861 

001862 {Delete the last paralmage inserted in the tempList if it pointed to the same 
001863 paragraph as the next textIl mage's first paral mage} 

001864 [F next Txtlmg.imageList.Size > 0 THEN 

001865 BEGIN 

001866 firstl mage := TParal mage(nextTxtl mg.imageList. First); 

001867 lastl mage := TParal mage(tempList. First); 
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001868 IF firstl mage. paragraph = |astl mage. paragraph THEN 

001869 BEGIN 

001870 firstl mage. I nvalLinesWth(0, MAXINT); 

001871 {$I FC fTextTrace} 

001872 IF fTextTrace THEN 

001873 BEGIN 

001874 LI nt ToHex(ORD(last!l mage), @str); 

001875 WriteLn('++ Recomputel mages: ', str, 

001876 ' points to same para as mxtTxt.firstlmg, so templist.del'); 
001877 END; 

001878 {$ENDC} 

001879 IF lastDrawnl mage = lastl mage THEN 

001880 lastDrawnl mage := NIL; 

001881 lastl mage. paragraph. i mages. Del Object(lastil mage, FALSE); 
001882 tempList. Del First( TRUE); 

001883 END; 

001884 END; 

001885 {$I FC fTextTrace} 

001886 |F fTextTrace THEN 

001887 WriteLn('++ Recomputel mages: About to insert rest of pimages into nextTl mage; list size=', 
001888 tempList.Size:1); 

001889 {$ENDC} 

001890 s := tempList. Scanner; 

001891 WHILE s.Scan(paral mage) DO 

001892 BEGIN 

001893 paral mage. textl mage := nextTxtl mg; 

001894 paral mage. | nvalLinesWith(0, MAXINT); 

001895 nextTxtl mg. i mageList.InsFirst( paral mage); 

001896 s. Del ete( FALSE); 

001897 END; 

001898 tempList. Free; 

001899 END; {last OneChanged} 

001900 END {nxtTxtl mg <> NIL} 

001901 ELSE 

001902 {lf we have stopped displaying in the middle of a paragraph and there is no next 
001903 text image to display the excess, then delete the remaining paral mages} 
001904 BEGIN 

001905 IF lastLP < 0 THEN 

001906 BEGIN 

001907 last Drawnl mage. paragraph. images. Del Obj ect(lastDrawnl mage, FALSE); 
001908 s. Del ete( TRUE); 

001909 END; 

001910 WHILE s.Scan(paral mage) DO 

001911 BEGIN 

001912 paral mage. paragraph. i mages. Del Obj ect( paral mage, FALSE); 

001913 s, Del ete( TRUE); 

001914 END; 

001915 END; 
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{Set up new bottom and erase any garbage due to text moving up} 
newBottom := SELF. | mageBottom 
IF newBottom < SELF. formerBottom THEN 

WITH SELF, extentLRect DO 


SetLRect(updateLRect, left-1, newBottom, right+l, formerBottom) 
IF realAction = actionDraw THEN 
FillLRect(updateLRect, | Pat White) 
ELSE IF realAction = actionlnval THEN 
thePad.inval LRect(updateLRect); 
IF inval Bits THEN 
updateLRect := zeroLRect; 
END; 
{$H+} 
SELF. formerBottom := newBottom 
|F SELF. growsDynamically THEN 
WITH SELF, extentLRect DO 


bottom := Max(newBottom, top + mi nHei ght); 


{Now tell the next textIl mage in the chain to recompute itself} 
next Txtl mg := SELF. next Txtl mg 
IF nextTxtl mg <> NIL THEN 

BEGIN 

{$I FC fTextTrace} 

|F fTextTrace THEN 


WriteLn('++ Recomputel mages: About to call Recomputel mages for nextTxtIlmg; nTl.imgLlst. Size=' 


next Txtlmg.imageList.Size:1); 


{$ENDC} 
IF lastDrawnl mage = NIL THEN 
nextTxtl mg.startLP := 0 
ELSE 
{$H-} nextTxtl mg.startLP := Max(0, lastDrawnl mage.endLP); {$H+} 
nextTxtl mg. firstindex := currParalndex; 
nextTxtl mg. Recomputel mages(drawAction, inval Bits) 
END; 


{$I1FC fTrace}EP; {$ENDC} 
{Recomputel mages } 


{$$ SgTxtCld} 


PROCEDURE TTextl mage. Resi ze(newExtent: LRect); 


BEGI 
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001964 {$1FC fTrace}BP( 10); {$ENDC} 

001965 SELF.extentLRect := newExtent; 

001966 SELF. I nval All 

001967 {$I1FC fTrace}EP; {$ENDC} 

001968 END; 

001969 

001970 

001971 {$8 SgTxt Hot} 

001972 FUNCTION TTextl mage. SeesSameAs(image: Tl mage): BOOLEAN 

001973 BEGIN 

001974 {$1FC fTrace}BP( 9); {$ENDC} 

001975 1F SELF = image THEN 

001976 SeesSameAs := TRUE 

001977 ELSE IF InClass(image, TParal mage) THEN 

001978 SeesSameAs := SELF.text = TParal mage(image).text! mage. text 
001979 ELSE IF InClass(image, TTextl mage) THEN 

001980 SeesSameAs := SELF.text = TTextl mage(image).text 

001981 ELSE 

001982 SeesSameAs := FALSE; 

001983 {$I1FC fTrace}EP; {$ENDC} 

001984 END; 

001985 

001986 {$8 SgTxtHot} 

001987 PROCEDURE TTextl mage. SetFirstIndex; 

001988 BEGIN 

001989 {$1FC fTrace}BP( 10); {$ENDC} 

001990 SELF. firstindex := 1; 

001991 {$I1FC fTrace}EP; {$ENDC} 

001992 END; 

001993 

001994 

001995 {$8 SgTxt Wrm} 

001996 FUNCTION TTextl mage. Txtl mgForClipBoard( heap: THeap; itsView: TView; itsLRect: LRect; 
001997 itsText:TText; isGrowable: BOOLEAN): TTextl mage 
001998 BEGIN 

001999 {$1FC fTrace}BP( 10); {$ENDC} 

002000 Txtl mgForClipBoard := TTextl mage. CREATE(NIL, heap, itsView, itsLRect, itsText, isGrowable); 
002001 {$I1FC fTrace}EP; {$ENDC} 

002002 END; 

002003 


002004 {$8 SgTxtI ni} 
002005 END; {Methods of TTextI mage} 


002006 

002007 

002008 METHODS OF TTextView 

002009 

002010 {$8 SgTxtCld} 

002011 FUNCTION TText View. CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itsExtent: LRect): TTextView 
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002012 BEGIN 

002013 {$IFC fTrace}BP( 10); {$ENDC} 

002014 IF object = NIL THEN 

002015 object := NewObject(heap, THISCLASS) 

002016 SELF := TTextView(itsPanel.NewView(object, itsExtent, TPrintManager. CREATE(NIL, heap), 
002017 stdMargins, FALSE {, Damnit! })) 
002018 SELF. textl mage := NIL; 

002019 SELF. valid := FALSE; 

002020 {$I FC fTrace}EP; {$ENDC} 

002021 END; 

002022 


002023 {$8 SgTxtCld} 
002024 {$lFC fTextTrace} 


002025 PROCEDURE TText View. Fields( PROCEDURE Field(nameAndType: $255)); 
002026 BEGI N 

002027 SUPERSELF. Fi el ds( Fi el d) 

002028 Field('textl mage: TTextl mage'); 

002029 Field('valid: BOOLEAN'); 

002030 Field(''); 

002031 END; 

002032 {$ENDC} 

002033 


002034 {$8 SgTxtCld} 
002035 {$lFC fUseUni vText } 


002036 PROCEDURE TText View. CreateUni versal Text; 

002037 VAR univText: TText WiteUnivText:; 

002038 BEGIN 

002039 {$I1FC fTrace}BP( 10); {$ENDC} 

002040 1F NOT clipBoard. hasUniversal Text THEN 

002041 BEGIN 

002042 univText := TTextWriteUnivText. CREATE(NIL, mainHeap, NIL, 512, 
002043 TTextSelection(SELF. panel.selection)); 
002044 univText. Free; 

002045 END; 

002046 {$I1FC fTrace}EP; {$ENDC} 

002047 END: 

002048 {$ENDC} 

002049 

002050 

002051 {$8 SgTxtCld} 

002052 FUNCTION TText View. CursorAt(mouseLPt: LPoint): TCursorNumber 
002053 BEGIN 

002054 {$1 FC fTrace}BP( 10); {$ENDC} 

002055 IF LPtIinLRect(mouseLPt, SELF.textl mage.extentLRect) THEN 
002056 CursorAt := textCursor 

002057 ELSE 

002058 CursorAt := arrowCursor 

002059 {$I1FC fTrace}EP; {$ENDC} 
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002060 
002061 
002062 
002063 
002064 
002065 
002066 
002067 
002068 
002069 
002070 
002071 
002072 
002073 
002074 
002075 
002076 
002077 
002078 
002079 
002080 
002081 
002082 
002083 
002084 
002085 
002086 
002087 
002088 
002089 
002090 
002091 
002092 
002093 
002094 
002095 
002096 
002097 
002098 
002099 
002100 
002101 
002102 
002103 
002104 
002105 
002106 
002107 


{$8 


{$8 


{$$ 
END; 


{$8 
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END; 


SgTxt Cl d} 
PROCEDURE TText Vi ew. Draw 
BEGIN 
{$IFC fTrace}BP( 10); {$ENDC} 
1F NOT SELF. valid THEN 
BEGIN 
SELF.textl mage. Recomputel mages(actionNone, TRUE); 
SELF.valid := TRUE; 
END; 
SELF. text! mage. Draw 
{$1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
PROCEDURE TText View. MousePress(mouseLPt: LPoint); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. text! mage. MousePress(mouseLPt); 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgTxtl ni } 
{Methods of TTextVi ew} 


SgTxt Cl d} 


{$I FC fUseUni vText } 
METHODS OF TTextWriteUnivText; 


{$8 


SgTxtCld} 
FUNCTION TTextWriteUnivText. CREATE(object: TObject; heap: THeap 


itsString: TString; itsDataSize: INTEGER 
itsTextSel: TTextSelection): TTextWriteUnivText; 


BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF object = NIL THEN 
object := NewObject( heap, THISCLASS) 
WITH TTextWriteUnivText(object) DO 


BEGIN 

textSelection := itsTextSel 

currlndex := 1; 

currPara := itsTextSel.textRange. first Para; 

currLP := 0; 

currStylelndex := 1; 

currTStyles := itsTextSel,textRange.firstPara.typeStyles 
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002108 END; 

002109 

002110 SELF := TTKWriteUnivText.CREATE(object, heap, itsString, itsDataSi ze) 
002111 {$I1FC fTrace}EP; {$ENDC} 

002112 END; 

002113 

002114 {$8 SgTxtCld} 

002115 {$lFC fTextTrace} 


002116 PROCEDURE TText WriteUnivText. Fields(PROCEDURE Field(nameAndType: $255)); 
002117 BEGIN 

002118 SUPERSELF. Fi el ds( Fi el d) 

002119 Field('textSelection: TTextSelection'); 

002120 Field('currlndex: LONGI NT' ) 

002121 Field('currPara: TEditPara'); 

002122 Field('currLP: I NTEGER'); 

002123 Field('currStylelndex: I NTEGER' ); 

002124 Field('currTStyles: TArray'); 

002125 Field(''); 

002126 END; 

002127 {$ENDC} 

002128 

002129 {$8 SgTxtCld} 

002130 PROCEDURE TText WriteUnivText. Fill Paragraph; 

002131 VAR startPos: INTEGER; 

002132 endPos: INTEGER 

002133 currChange: TStyleChange 

002134 nextChange: TStyl eChange 

002135 numChars: INTEGER 

002136 BEGIN 

002137 {$I1FC fTrace}BP( 10); {$ENDC} 

002138 {$I FC fTextTrace} 

002139 IF fTextTrace THEN 

002140 BEGIN 

002141 WriteLn('<-> Entering Fill Run: Current fields are:') 

002142 WriteLn(' <-> currindex = ', SELF.currindex:1, ' currStylelndex = ', SELF.currStyl el ndex: 1) 
002143 WriteLn(' <-> currLP = ', SELF. currLP: 1); 

002144 END; 

002145 {$ENDC} 

002146 SELF. data. Del Al | 

002147 [F SELF.currlndex <= SELF.textSelection.textRange.lastIndex THEN 
002148 BEGIN 

002149 WITH SELF. paragraphDescriptor, SELF.currPara.format DO 
002150 BEGIN 

002151 paragraphStart := SELF. textSelection.isParaSelection AND {LSR} 
002152 (SELF.currLP = 0); 

002153 firstLineMargin := first! ndent 

002154 bodyMargin := leftIndent 

002155 rightMargin := rightMargin - rightIndent; {2222} 
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002156 paraLeading := spaceBel owPara; 

002157 END; 

002158 IF SELF.currPara.size = 0 THEN 

002159 BEGIN 

002160 endPos := 0: 

002161 numChars := 0; 

002162 END 

002163 ELSE 

002164 BEGIN 

002165 REPEAT 

002166 SELF. currTStyles. GetAt(SELF.currStylelndex, @currChange) 
002167 WITH SELF.characterDescriptor DO 

002168 BEGIN 

002169 {$H- } 

002170 font := QDFontNumber(currChange. newSt yl e) 

002171 {$H+} 

002172 face := currChange. newStyle. onFaces 

002173 END; 

002174 startPos := Max(SELF.currLP, currChange.!Ip) + 1; 

002175 SELF.currTStyles, GetAt(SELF.currStylelndex+i1, @next Change) 
002176 endPos := Min(SELF.currPara.size, nextChange. |p) 

002177 numChars := endPos - startPos + 1; 

002178 1F numChars = 0 THEN 

002179 SELF.currStylelndex := SELF.currStylelndex + 1; 
002180 UNTIL numChars > 0; 

002181 SELF. data. I nsManyAt(1, SELF.currPara, startPos, numChars) 
002182 END; 

002183 IF endPos = SELF.currPara.size THEN 

002184 BEGIN 

002185 SELF. currlndex := SELF.currlndex + 1: 

002186 WITH SELF DO 

002187 IF currlndex <= textSelection.textRange.|astindex THEN 
002188 BEGIN 

002189 currLP := 0; 

002190 currStylelndex := 1; 

002191 {$H- } 

002192 currPara := TEditPara(SELF.textSelection.textl mage.text. paragraphs. At( 
002193 SELF. currl ndex)); 
002194 {$H+} 

002195 currTStyles := currPara.typeStyles 

002196 {$H- } 

002197 SELF. data. I nsAt(numCharstl, CHR(ascReturn)); {last statement in I F!!} 
002198 {$H+} 

002199 END 

002200 ELSE IF textSelection.isParaSelection THEN 

002201 {$H- } 

002202 SELF. data. I nsAt(numCharstl, CHR(ascReturn)); {last statement in I F!!} 
002203 {$H+} 
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002204 END 

002205 ELSE 

002206 BEGIN 

002207 SELF.currLP := SELF.currLP + numChars 

002208 SELF. paragraphDescriptor.additional ChrinParagraph := {LSR} 
002209 SELF.currPara.size - endPos + 1: 

002210 END; 

002211 END; 

002212 {$I1FC fTextTrace} 

002213 1F fTextTrace THEN 

002214 BEGIN 

002215 WriteLn; 

002216 WriteLn('>-< EXITING Fill Run: Current fields are:'); 

002217 WriteLn('>-< currindex = ', SELF.currindex:1, ' currStylelndex = ', SELF.currStyl el ndex: 1) 
002218 WriteLn('>-< currLP = ', SELF. currLP: 1); 

002219 WriteLn(' kasi ja, Gimyata fo, ed Yee: alee SP Sead Jal ABC Oe FONE se Shaseha see raiala Beeler jare, Stel ae, ate lesa) 6, dealeialo, eee ete je, ate '); 
002220 END; 

002221 {$ENDC} 

002222 {$1FC fTrace}EP; {$ENDC} 

002223 END: 

002224 


002225 {$8 SgTxtI ni} 

002226 END; {Methods of TTextWriteUni vText } 
002227 {$ENDC} 

002228 

002229 {$8 SgTxtI ni} 

002230 

002231 

002232 


End of File -- Lines: 2232 Characters: 80799 
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FILE: "LIBTK/ UTEXT4, TEXT" 


000001 {UText4} 

000002 {TEXT SELECTION TYPES AND COMMANDS} 

000003 

000004 

000005 {changed 04/27/84 1307 Change to TTypi ngCmd. Perform} 

000006 {changed 04/25/84 1406 Got rid of IF numParas = 1 in Adjust proc in InsertText} 

000007 {changed 04/25/84 1250 Changed TStyleCmd. FilterAndDo back to filtering TParal mage for Compugraphic} 
000008 {changed 04/19/84 1308 Set up fields for partial line erasing in KeyPause} 

000009 {changed 04/17/84 1720 In TTextSelection. CutCopy, changed "IF firstLP >= 0" to "IF firstLP > 0"} 
000010 {changed 04/16/84 1414 Set viewLRect origined at (0,0) in TTextSel ection. Cut Copy} 

000011 {changed 04/16/84 1322 Set textl mage. minHeight to 0 in TOnePara and TMultiPara. CopySelf} 

000012 {changed 04/16/84 1024 Call recomputel mages in TOnePara and TMultiPara.CopySelf to set clipView size} 
000013 {changed 04/13/84 1736 First parameter decremented in calls to TParagraph. Styl eAt; 


000014 No longer set unHighlightBefore[doPhase] to FALSE in typingCmd 

000015 Set TinsertionPoint.justReturned to FALSE in all Key methods (except KeyReturn) 
000016 Call StyleFromContext in TStyl eCmd. Perform} 

000017 {changed 04/13/84 1531 TStyleCmd.FilterAndDo now filters a TEditPara rather than a TParal mage 

000018 Call StyleFromContext through a filter in TTextSel ection. CREATE} 

000019 {changed 04/13/84 1102 Tlnsertion. MousePress: Allow selecting of word when double click on last half 
000020 of last character in word} 


000021 {changed 04/13/84 0209 Changed all calls to TEditPara. CREATE to TTextl mage. NewEdit Para} 

000022 {changed 04/09/84 1530 Set highlightAfter[doPhase] FALSE in TTypingCmd. CREATE} 

000023 {changed 04/09/84 1337 Set deferUpdate TRUE in TTypingCmd. Perform (do phase) } 

000024 {changed 04/09/84 1202 Tlnsertion. MousePress: Made sure all insertion points had their isPara flags 


000025 set when triple click on an empty paragraph; 

000026 Ti nsertionPoint.MouseMove: Don't unHighlight if isPara was TRUE} 

000027 

000028 

000029 

000030 {$8 SgTxtHot} 

000031 

000032 

000033 METHODS OF TTextSel ection; 

000034 

000035 {$8 SgTxtHot} 

000036 FUNCTION TTextSelection. CREATE(object: TObject; heap: THeap; itsView: TView 

000037 itsTextl mage: TTextl mage; itsAnchorLPt: LPoint; 
000038 beginPara: TEditPara; beginlndex: LONGINT; beginLP: INTEGER 
000039 endPara: TEditPara; endindex: LONGINT; endLP: INTEGER 
000040 ): TTextSel ection; 

000041 

000042 {Need to filter paragraph before asking about its type styles} 

000043 PROCEDURE FindFilteredStyle(obj: TObj ect); 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 


{$8 


{$8 


VAR 
BEGI 


END; 
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BEGIN 
SELF. Styl eFromContext; 
END; 


range: TTextRange; 
N 
{$IFC fTrace}BP( 9); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TTextSelection(TSelection, CREATE(object, heap, itsView, somethingKind, itsAnchorLPt)); 


range := TTextRange.CREATE(NIL, heap, beginPara, beginlndex, beginLP, endPara, endindex, endLP) 
WITH SELF DO 

BEGIN 

textl mage := itsTextl mage; 

textRange := range 

isWordSelection := FALSE; 

isParaSelection := FALSE; 


amTyping := FALSE; 
viewTick := -1; { force recalculation of selection range } 
END; 


SELF. text! mage. FilterAndDo(TParal mage(beginPara.images. First), FindFilteredStyle) 
{$SIFC fTrace}EP; {$ENDC} 


SgTxt Hot } 
PROCEDURE TTextSelecti on. Free 


BEGI 


N 

{$IFC fTrace}BP( 10); {$ENDC} 
SELF. textRange. Free 
SUPERSELF. Free; 

{$I1FC fTrace}EP; {$ENDC} 


END; 
SgTxt Wr m} 
FUNCTION TTextSelection.Clone(heap: THeap): TObj ect; 
VAR textSel: TText Selection; 
range: TText Range 
BEGIN 


END; 


{$1FC fTrace}BP( 10); {$ENDC} 

range := TTextRange( SELF. text Range. Cl one( heap) ) 
textSel := TTextSelection(SUPERSELF. Cl one( heap) ) 
textSel.textRange := range 

Clone := textSel 

{$I1FC fTrace}EP; {$ENDC} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 858 of 1012 


000092 
000093 
000094 
000095 
000096 
000097 
000098 
000099 
000100 
000101 
000102 
000103 
000104 
000105 
000106 
000107 
000108 
000109 
000110 
000111 
000112 
000113 
000114 
000115 
000116 
000117 
000118 
000119 
000120 
000121 
000122 
000123 
000124 
000125 
000126 
000127 
000128 
000129 
000130 
000131 
000132 
000133 
000134 
000135 
000136 
000137 
000138 
000139 
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{$$ SgTxtCld} 
{$I FC fTextTrace} 
PROCEDURE TTextSelection. Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
SUPERSELF. Fields( Field); 
Field('textl mage: TTextl mage' ) 
Field('textRange: TTextRange' ) 
Field('isWordSelection: BOOLEAN' ) 
Field('isParaSelection: BOOLEAN' ) 
Field('viewTick: | NTEGER'); 
Field('amTyping: BOOLEAN' ); 
Field('onFaces: I NTEGER'); 
Field('font: INTEGER' ) 
Field(''); 
END; 
{$ENDC} 


{$$ SgTxt Hot} 
FUNCTION TTextSelection. Becomel nsertionPoint: TlnsertionPoint; 
VAR insertionPt: Tl nsertionPoi nt; 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
insertionPt := Ti nsertionPoi nt( SELF. FreedAndRepl acedBy( 
Ti nsertionPoi nt. CREATE( NIL, SELF. Heap, 
SELF.view, SELF. textl mage, SELF.anchorLPt, 
SELF. textRange. firstPara, 
SELF.textRange.firstIndex, 
SELF.textRange.firstLP))); 
SELF. text! mage. text. ChangeSel | nOtherPanels(inserti onPt); 
Becomel nsertionPoint := insertionPt; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Wrm} 
FUNCTION TTextSel ection. CanDoCommand(cmdNumber: TCmdNumber; VAR checklt: BOOLEAN): BOOLEAN 
VAR typeStyle: TTypeStyle; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
CASE cmdNumber OF 
uModern, uClassic: 
BEGIN 
CanDoCommand : = TRUE; 
typeStyle := SELF.currTypeStyle 
checklt := (cmdNumber - uModern + 1) = typeStyle. font. fontFamil y; 
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000140 
000141 
000142 
000143 
000144 
000145 
000146 
000147 
000148 
000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
000158 
000159 
000160 
000161 
000162 
000163 
000164 
000165 
000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 
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END; 
u20Pitch, ul5Pitch, ul2Pitch, ulOPitch, ul2Point, ul4Point, ul8Point, u24Point: 
BEGIN 
CanDoCommand := TRUE; 
typeStyle := SELF.currTypeStyle 
checklt := (cmdNumber - u20Pitch + 1) = typeStyle.font.fontSize 
END; 
{$1FC LibraryVersion <= 20} 
uFnt0O, uFnt1, uFnt2, uFnt3, uFnt4, uFnt5, uFnt6, uFnt7, uFnt8, uFnt9, uFnt10, uFntll 
BEGIN 
CanDoCommand := TRUE; 
WITH SELF. currTypeStyle.font DO 
CASE cmdNumber OF 
uFnt0: checklt := fontFamily = famSystem 
uFntl: checklt := (fontFamily = famModern) AND (fontSize = sizel5Pitch); 
uFnt2: checklt := (fontFamily = famModern) AND (fontSize = sizel2Pitch); 
uFnt3: checklt := (fontFamily = famClassic) AND (fontSize = sizel2Pitch); 
uFnt4: checklt := (fontFamily = famModern) AND (fontSize = sizel0Pitch); 
uFnt5: checklt := (fontFamily = famModern) AND (fontSize = sizel4Point); 
uFnt6: checklt := (fontFamily = famModern) AND (fontSize = sizel2Point); 
uFnt7: checklt := (fontFamily = famClassic) AND (fontSize = sizel2Point); 
uFnts8: checklt := (fontFamily = famModern) AND (fontSize = sizel8Point); 
uFnt9: checklt := (fontFamily = famClassic) AND (fontSize = sizel8Point); 
uFntl0: checkit := (fontFamily = famModern) AND (fontSize = size24Point); 
uFntli: checkit := (fontFamily = famClassic) AND (fontSize = size24Point); 
END; 
END; 
{$ENDC} 
uPlain, uBold, ultalic, uUnderline, uShadow, uOutline 
BEGIN 
CanDoCommand := TRUE; 
typeStyle := SELF.currTypeStyle 
WITH typeStyle DO 
CASE cmdNumber OF 
uPl ain: checklt := onFaces=[]; 
uBold: checklt := (bold in onFaces) 
ultalic: checklt := (italic in onFaces) 
uUnderline: checklt := (underlined in onFaces); 
uShadow: checklt := (shadow in onFaces) 
uOutline: checklt := (outline in onFaces) 
END; 
END; 
uCut, uCopy, uClear: 
CanDoCommand := TRUE; 
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000188 
000189 
000190 
000191 
000192 
000193 
000194 
000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
000210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
000228 
000229 
000230 
000231 
000232 
000233 
000234 
000235 


{$8 


{$8 
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uPaste: 
BEGIN 
clipboard. Inspect; 
IF (clipboard. hasView) OR (clipBoard. hasUniversal Text) THEN 
CanDoCommand := TRUE: 
END; 


OTHERW SE 
CanDoCommand : = SUPERSELF. CanDoCommand(cmdNumber, checklt); 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
PROCEDURE TTextSelection. ChangeStyle(cmdNumber: TCmdNumber); 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
Write(chr(7),'Change typestyle not implemented for this selection type. '); 
WriteLn ('(cmdNumber= ',cmdNumber:1,')'); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
PROCEDURE TTextSelection. ChangeText( PROCEDURE TextEdit; PROCEDURE Adjust); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. MarkChanged; 
TextEdit; 
Adj ust; 
1F NOT deferUpdate THEN 
BEGIN 
SELF. textIl mage. text. Recomputel mages 
(*SELF.textl mage. text. I nvalidate; *) 
END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
FUNCTION TTextSelection.CopySelf(heap: THeap; view: TView): TMulti ParaSel ection; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
CopySelf := NIL; 
{$I1FC fTrace}EP; {$ENDC} 
END; 
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000236 

000237 

000238 {$8 SgTxtCld} 

000239 PROCEDURE TTextSelection. CutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN); 
000240 VAR clipHeap: THeap; 

000241 clipPanel: TPanel: 

000242 clipView: TText View 

000243 vi ewLRect: LRect; 

000244 text: TText; 

000245 insPt: TI nsertionPoint; 

000246 clipTextSelection: TMultiParaSel ection; 

000247 sel Size: INTEGER; 

000248 checkLast: BOOLEAN 

000249 

000250 BEGIN 

000251 {$I1FC fTrace}BP(11); {$ENDC} 

000252 clipHeap := clipSelection. heap; 

000253 clipPanel := clipSelection. panel 

000254 viewLRect := SELF.textl mage. extentLRect; 

000255 SetLRect(viewLRect, 0, 0, viewLRect.right - viewLRect.left + 2 * cHorizMargin, 
000256 viewLRect. bottom - viewLRect.top + 2 * cVertMargin) 
000257 clipView := TTextView. CREATE(NIL, clipHeap, clipPanel, viewLRect) 

000258 clipTextSelection := TMultiParaSelection(clipSel ection. FreedAndRepl acedBy( 

000259 SELF. CopySelf(clipHeap, clipView))) 
000260 clipView. valid := TRUE; 

000261 clipTextSelection.isParaSelection := SELF.isParaSel ection; 

000262 clipTextSelection.isWordSelection := SELF.isWordSel ection; 

000263 {I ntelligence!! Even if word flag not set, let's see if we qualify as a word selection anyway} 
000264 1F NOT SELF.isWordSelection THEN 

000265 WITH SELF. textRange DO 

000266 {$H- } 

000267 clipTextSelection.isWordSelection := firstPara. Qualifies(firstLP) AND 
000268 lastPara. Qualifies(lastLP-1) AND 
000269 NOT firstPara. Qualifies(firstLP-1) AND 
000270 NOT last Para. Qualifies(lastLP) 
000271 {$H+} 

000272 clipView.textl mage := clipTextSelection.textl mage 

000273 1F deleteOriginal THEN 

000274 BEGIN 

000275 {Intelligent Cut: Delete extra space} 

000276 IF clipTextSelection.isWordSelection THEN 

000277 WITH SELF. textRange DO 

000278 BEGIN 

000279 {$H- } 

000280 checkLast := TRUE; 

000281 IF firstLP > 0 THEN 

000282 IF firstPara. At(firstLp) = ' ' THEN 

000283 BEGIN 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
000295 
000296 
000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 
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firstLP := firstLP - 1; 


checkLast := FALSE; 
END; 
IF checkLast AND (lastLP < lastPara.size) THEN 
IF lastPara. At(lastLP + 1) = ' ' THEN 
lastLP := |astLP + 1: 
{$H+} 
END; 
SELF. Del eteAndFree 
insPt := SELF. Becomel nserti onPoi nt 


END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
PROCEDURE TTextSelecti on. Del eteAndFree 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
FUNCTION TTextSelection. DeleteButSave: TText; 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
DeleteButSave := NIL; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$8 SgTxtCld} 
PROCEDURE TTextSelection. DoChangeStyle(cmdNumber: TCmdNumber; paragraph: TParagraph; 
firstLP: INTEGER; |astLP: INTEGER; VAR newStyle: TTypeStyle) 


VAR onFaces: {$1FC LibraryVersion <= 20}TSeteface{$ELSEC}Styl e{$ENDC}; 
faceChange: BOOLEAN 
BEGIN 


{$1 FC fTrace}BP( 10); {$ENDC} 
{$IFC fTextTrace} 
IF fTextTrace THEN 


BEGIN 
WriteLn(' +. Entering TTextSelection. DoChangeStyle: firstLP = ', firstLP:1, 
' TastLP =', lastLP:1); 
END; 
{$ENDC} 


faceChange := TRUE; 
CASE cmdNumber OF 
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000332 
000333 
000334 
000335 
000336 
000337 
000338 
000339 
000340 
000341 
000342 
000343 
000344 
000345 
000346 
000347 
000348 
000349 
000350 
000351 
000352 
000353 
000354 
000355 
000356 
000357 
000358 
000359 
000360 
000361 
000362 
000363 
000364 
000365 
000366 
000367 
000368 
000369 
000370 
000371 
000372 
000373 
000374 
000375 
000376 
000377 
000378 
000379 
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uPl ain: 

onFaces := []; 
uBold: 

onFaces := [bold] 
ultalic: 

onFaces := [italic] 
uUnderline: 

onFaces := [underlined] 
uShadow: 

onFaces := [shadow] 
uOutline: 

onFaces := [outline] 


uModern, uClassic: 
BEGIN 
faceChange := FALSE; 
paragraph. ChgFontFamily(firstLP, lastLP, cmdNumber - uModern + 1, newStyle) 
END: 


{$1FC LibraryVersion <= 20} 
uFnt0O, uFnt1, uFnt2, uFnt3, uFnt4, uFnt5, uFnt6, uFnt7, uFnt8, uFnt9, uFnt10, uFntll 
BEGIN 
faceChange := FALSE; 
CASE cmdNumber OF 
uFnt0: paragraph. ChgFontFamily(firstLP, lastLP, famSystem, newStyle); 
uFnt1: 
BEGIN 
paragraph. ChgFontFamily(firstLP, lastLP, famModern, newStyle); 
paragraph. ChgFontSize(firstLP, lastLP, sizel5Pitch, newStyle); 
END; 
uFnt 2: 
BEGIN 
paragraph. ChgFontFamily(firstLP, lastLP, famModern, newStyl e) 
paragraph. ChgFontSize(firstLP, lastLP, sizel2Pitch, newStyle); 
END; 
uFnt 3: 
BEGIN 
paragraph. ChgFontFamily(firstLP, lastLP, famClassic, newStyle) 
paragraph. ChgFontSize(firstLP, lastLP, sizel2Pitch, newStyle); 
END; 
uF nt 4: 
BEGIN 
paragraph. ChgFontFamily(firstLP, lastLP, famModern, newStyle); 
paragraph. ChgFontSize(firstLP, lastLP, sizel0Pitch, newStyle); 
END; 
uFnt 5: 
BEGIN 
paragraph. ChgFontFamily(firstLP, lastLP, famModern, newStyl e) 
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000380 paragraph. ChgFontSize(firstLP, lastLP, sizel4Point, newStyle) 
000381 END; 

000382 uFnt 6: 

000383 BEGIN 

000384 paragraph. ChgFontFamily(firstLP, lastLP, famModern, newStyl e) 
000385 paragraph. ChgFontSize(firstLP, lastLP, sizel2Point, newStyle) 
000386 END; 

000387 uFnt7: 

000388 BEGIN 

000389 paragraph. ChgFontFamily(firstLP, lastLP, famClassic, newStyle) 
000390 paragraph. ChgFontSize(firstLP, lastLP, sizel2Point, newStyle) 
000391 END; 

000392 uFnt 8: 

000393 BEGIN 

000394 paragraph. ChgFontFamily(firstLP, lastLP, famModern, newStyle) 
000395 paragraph. ChgFontSize(firstLP, lastLP, sizel8Point, newStyle) 
000396 END; 

000397 uFnt 9: 

000398 BEGIN 

000399 paragraph. ChgFontFamily(firstLP, lastLP, famClassic, newStyle) 
000400 paragraph. ChgFontSize(firstLP, lastLP, size1l8Point, newStyle) 
000401 END; 

000402 uFnt 10: 

000403 BEGIN 

000404 paragraph. ChgFontFamily(firstLP, lastLP, famModern, newStyl e) 
000405 paragraph. ChgFontSize(firstLP, lastLP, size24Point, newStyle) 
000406 END; 

000407 uFnt1l: 

000408 BEGIN 

000409 paragraph. ChgFontFamily(firstLP, lastLP, famClassic, newStyle) 
000410 paragraph. ChgFontSize(firstLP, lastLP, size24Point, newStyle) 
000411 END; 

000412 END; 

000413 END; 

000414 {$ENDC} 

000415 

000416 OTHERW SE 

000417 BEGIN 

000418 faceChange := FALSE; 

000419 paragraph. ChgFontSize(firstLP, lastLP, cmdNumber - u20Pitch + 1, newStyle) 
000420 END; 

000421 END; 

000422 

000423 IF faceChange THEN 

000424 paragraph. ChgFace(firstLP, lastLP, onFaces, newStyle) 

000425 {$IFC fTrace}EP; {$ENDC} 

000426 END; 

000427 
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000428 
000429 
000430 
000431 
000432 
000433 
000434 
000435 
000436 
000437 
000438 
000439 
000440 
000441 
000442 
000443 
000444 
000445 
000446 
000447 
000448 
000449 
000450 
000451 
000452 
000453 
000454 
000455 
000456 
000457 
000458 
000459 
000460 
000461 
000462 
000463 
000464 
000465 
000466 
000467 
000468 
000469 
000470 
000471 
000472 
000473 
000474 
000475 


{$8 


{$8 
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SgTxt Cl d} 
PROCEDURE TTextSelection. GetHysteresis(VAR hysterPt: Point); 
BEGIN 
{$1FC fTrace}BP( 6); {$ENDC} 
hysterPt := zeroPt; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
PROCEDURE TTextSelection. Hi ghlight(highTransit: THighTransit); 
BEGIN 

{$1FC fTrace}BP( 10); {$ENDC} 


{Note that this is called from TPanel. Highlight which does an OnAllPadsDo, thus we do not 


call TText.HiliteParagraphs, but rather we call TTextI mage. HiliteText } 


[F SELF.textl mage.imageList.size > 0 THEN 
WITH SELF. textRange DO 
{$H- } 


SELF.textl mage. headTxtl mg. HiliteText(highTransit, firstIlndex, firstLP, lastindex, 


SELF.isParaSel ection); 


{$H+} 
{$I1FC fTrace}EP; {$ENDC} 


SgTxt Cl d} 

PROCEDURE TTextSelection.Invalidate; 

BEGIN 
{$IFC fTrace}BP( 10); {$ENDC} 
SELF. text! mage. text.I nvalidate; 
{$I1FC fTrace}EP; {$ENDC} 

END; 


(* This is now done automatically by the ToolKit 


{$8 


ay 


{$8 


SgTxt Hot } 
PROCEDURE TText Selection. KeyCl ear 
BEGIN 

{$1FC fTrace}BP( 10); {$ENDC} 


SELF. window. PerformCommand(TCl earTextCmd. CREATE(NIL, SELF. Heap, uClear 
SELF.textl mage, SELF. text! mage. text) ); 


{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
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lastLP, 


000476 
000477 
000478 
000479 
000480 
000481 
000482 
000483 
000484 
000485 
000486 
000487 
000488 
000489 
000490 
000491 
000492 
000493 
000494 
000495 
000496 
000497 
000498 
000499 
000500 
000501 
000502 
000503 
000504 
000505 
000506 
000507 
000508 
000509 
000510 
000511 
000512 
000513 
000514 
000515 
000516 
000517 
000518 
000519 
000520 
000521 
000522 
000523 


{$8 


{$8 


{$8 


{$8 
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PROCEDURE TText Selection. KeyBack(f Word: BOOLEAN); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
{This will create the typing command, which deletes any selected text} 
SELF. KeyText; 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
PROCEDURE TTextSelection. KeyChar(ch: CHAR); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. KeyText; 
SELF. KeyChar(ch); {!!! Assumes SELF was converted to insertion point} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Wr m} 
PROCEDURE TText Selection. KeyReturn; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. KeyText; 
SELF. KeyReturn; {!!! Assumes SELF was converted to insertion point} 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
PROCEDURE TText Selection. KeyText; 
BEGIN 

{$I1FC fTrace}BP(7); {$ENDC} 

[F NOT SELF. amlyping THEN 

SELF. window. PerformCommand(TTypingCmd. CREATE(NIL, SELF. Heap, 
SELF.textl mage, SELF. text! mage. text) ); 

{$1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 

PROCEDURE TText Selection. MarkChanged 

BEGIN 
{$IFC fTrace}BP( 10); {$ENDC} 
SUPERSELF. Mar kChanged 
SELF. text! mage. text. MarkChanged( SELF. text Range) ; 
{$I1FC fTrace}EP; {$ENDC} 

END; 
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000525 
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{$S SgTxtCld} 
PROCEDURE TText Selection. MousePress(mouseLPt: 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF clickState.fShift THEN 
SELF. MouseMove( mouseLPt) 
ELSE 
SELF. textl mage. MousePress(mouseLPt); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


LPoi nt); 


{$$ SgTxt Hot} 
PROCEDURE TText Selection. MouseRel ease 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
ObscureCursor; 
{$1FC fTrace}EP; {$ENDC} 


END; 


wm 


{$$ SgTxtCld} 
FUNCTION TTextSel ection. NewCommand(cmdNumber: 
VAR heap: THeap; 
textl mage: TTextl mage 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
NewCommand := NIL; 
heap := SELF. heap; 
textl mage := SELF. textl mage 
CASE cmdNumber OF 
u20Pitch, ul5Pitch, ul2Pitch, 
uModern, uClassic, 
uPlain, uBold, ultalic, 
NewCommand 


TCmdNumber): 


ulOPitch, ul2Poi nt, 


uUnderline, uShadow 


{$1FC LibraryVersion <= 20} 

uFnt0, uFnti1, uFnt2, uFnt3, 
NewCommand 

{$ENDC} 


uFnt4, uFnt5, uFnt6, 


uCut, uCopy: 
NewCommand : = 


uClear: 


NewCommand := TClearTextCmd, CREATE(NIL, SELF. Heap 
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ul4Poi nt, 


uFnt7, 
:= SELF.NewStyleCmd(heap, cmdNumber, text! mage) 


TCommand: 


ul8Point, u24Poi nt, 


uOutline: 
:= SELF.NewStyleCmd(heap, cmdNumber, text! mage) 


uFnt8, uFnt9, uFntl0, uFnt1l: 


SELF. NewCutCopyCmd( heap, cmdNumber, textl mage) 


uClear, textIl mage, textl mage. text); 
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000572 
000573 
000574 
000575 
000576 
000577 
000578 
000579 
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000581 
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000583 
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000585 
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000587 
000588 
000589 
000590 
000591 
000592 
000593 
000594 
000595 
000596 
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000598 
000599 
000600 
000601 
000602 
000603 
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000606 
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000614 
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uPaste: 
NewCommand := TTextPaste. CREATE(NIL, heap, textIl mage, textIl mage. text); 


{cFormat Changes: } 


OTHERW SE 
NewCommand := SUPERSELF. NewCommand( cmdNumber ) 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S SgTxtCld} 
FUNCTION TTextSelection. NewCutCopyCmd( heap: THeap; cmdNumber: TCmdNumber 
textl mage: TTextl mage): TCommand 

BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
NewCutCopyCmd := TTextCutCopy. CREATE(NIL, heap, cmdNumber, textl mage 

cmdNumber=uCut, textl mage.text); 

{$I1FC fTrace}EP; {$ENDC} 


{$$ SgTxtCld} 
FUNCTION TTextSelection. NewStyleCmd(heap: THeap; cmdNumber: TCmdNumber 
textl mage: TTextl mage): TCommand 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
WITH SELF. textRange DO 
{$H-} 
NewStyleCmd := TStyleCmd. CREATE(NIL, heap, cmdNumber, textIl mage, firstIndex, lastlndex 
firstLP, lastLP, SELF) 
{$H+} 
{$SIFC fTrace}EP; {$ENDC} 
END; 


{$S SgTxtCld} 
FUNCTION TTextSelection. ReplicateForOtherPanel (itsTextl mage: TTextl mage): TTextSel ection; 
VAR sel: TTextSel ection; 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
WITH SELF. textRange DO 


{$H- } 

sel := itsTextl mage. NewTextSelection(firstPara, firstindex, firstLP 
lastPara, lastIindex, lastLP) 

{$H+} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 869 of 1012 


000620 
000621 
000622 
000623 
000624 
000625 
000626 
000627 
000628 
000629 
000630 
000631 
000632 
000633 
000634 
000635 
000636 
000637 
000638 
000639 
000640 
000641 
000642 
000643 
000644 
000645 
000646 
000647 
000648 
000649 
000650 
000651 
000652 
000653 
000654 
000655 
000656 
000657 
000658 
000659 
000660 
000661 
000662 
000663 
000664 
000665 
000666 
000667 
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sel.isParaSelection := SELF.isParaSel ection; 
sel.isWordSelection := SELF. isWordSel ection; 
ReplicateForOtherPanel := sel 
{$1FC fTrace}EP; {$ENDC} 

END; 


{$$ SgTxtCld} 
PROCEDURE TTextSelection, Styl eFromContext; 
BEGIN 

FC fTrace}BP( 9); {$ENDC} 

FC fTrace}EP; {$ENDC} 


{$$ SgTxtl ni} 
END; {METHODS OF TTextSel ection} 


METHODS OF TinsertionPoint; 


{$$ SgTxt Hot} 

FUNCTION TI nsertionPoint. CREATE(object: TObject; heap: THeap; it 
itsAnchorLPt: LPoint; 
itsLP: INTEGER): 

VAR s: 

paragraph: 

BEGIN 

{$1FC fTrace}BP( 10); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 


TListScanner; 
TEdit Para; 


IF itsIndex <= 0 THEN 

BEGIN 

s := itsTextl mage. text. paragraphs. Scanner 

WHILE s.Scan(paragraph) DO 

[F paragraph = itsParagraph THEN 

BEGIN 
itslndex := 
s. Done; 
END; 


Ss. position; 


END; 


SELF := TinsertionPoint(TTextSelection. CREATE( object, heap, 


itsParagraph, itsIndex, 


itsParagraph. bsCount := 0 
WITH SELF DO 
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itsParagraph: 
Til nsertionPoint; 


sView: TView; itsText! mage: 


TEditPara; itsIndex: 


TTextl mage; 
LONGI NT; 


itsAnchorLPt, 
itsLP)); 


itsVi ew, 
itsLP, itsParagraph, 


itsTextl mage, 
itsIndex, 
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000668 
000669 
000670 
000671 
000672 
000673 
000674 
000675 
000676 
000677 
000678 
000679 
000680 
000681 
000682 
000683 
000684 
000685 
000686 
000687 
000688 
000689 
000690 
000691 
000692 
000693 
000694 
000695 
000696 
000697 
000698 
000699 
000700 
000701 
000702 
000703 
000704 
000705 
000706 
000707 
000708 
000709 
000710 
000711 
000712 
000713 
000714 
000715 


{$8 


{$8 


{$S 
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BEGIN 
typingCmd := NIL; 
styleCmdNumber := 0; 
newestLP := itsLP 
nextHighTransit := hOnToOff; 
justReturned := FALSE; 
END; 

{$I1FC fTrace}EP; {$ENDC} 

END; 


SgTxt Hot } 
PROCEDURE TI nsertionPoi nt. Free 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
[F SELF.typingCmd <> NIL THEN 
WITH SELF, typingCmd.typingRange DO 
BEGIN 
lastPara := textrange.firstPara; 
lastIndex := textrange.firstI ndex; 
lastLP := textrange.firstLP 
END; 
* 


SELF. textRange. firstPara. StopEdit; 
* 


SUPERSELF. Free; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Wr m} 
FUNCTION TI nsertionPoint.Clone(heap: THeap): TObj ect; 
VAR insPt: TlinsertionPoint; 
BEGIN 
{$IFC fTrace}BP( 10); {$ENDC} 
insPt := TIlnsertionPoi nt(SUPERSELF. Cl one( heap) ) 
insPt.typingCmd := NIL; 
insPt.amTyping := FALSE; 
Clone := insPt; 
{$1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 


{$1 FC fTextTrace} 


PROCEDURE TinsertionPoi nt. Fields( PROCEDURE Field(nameAndType: $255)) 
BEGIN 
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000716 
000717 
000718 
000719 
000720 
000721 
000722 
000723 
000724 
000725 
000726 
000727 
000728 
000729 
000730 
000731 
000732 
000733 
000734 
000735 
000736 
000737 
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000740 
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000744 
000745 
000746 
000747 
000748 
000749 
000750 
000751 
000752 
000753 
000754 
000755 
000756 
000757 
000758 
000759 
000760 
000761 
000762 
000763 
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TTextSelection. Fields( Field); 
Field('typingCmd: TTypingCmd' ) 
Field('styleCmdNumber: I NTEGER' ); 
Field('newestLP: | NTEGER'); 
Field('justReturned: BOOLEAN' ) 
Field('nextHighTransit: Byte') 
Field('nextTransitTime: LONGI NT') 
Field(''); 

END; 


{$ENDC} 


{$8 


{$8 


{$8 


{$8 


SgTxt Hot } 
FUNCTION Tl nsertionPoint. Becomel nsertionPoint: TinsertionPoint; 
BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
Becomel nsertionPoint := SELF; 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgTxt Wr m} 
FUNCTION Tl nsertionPoi nt. CanDoCommand(cmdNumber: TCmdNumber; VAR checkilt: BOOLEAN): BOOLEAN 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
CASE cmdNumber OF 
uCut, uCopy: 
CanDoCommand := FALSE; 


OTHERW SE 
CanDoCommand : = SUPERSELF.CanDoCommand(cmdNumber, checklt); 
END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
PROCEDURE TinsertionPoint.CutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN) 
BEGIN 

{$I FC fTrace}BP(11); {$ENDC} 

(* Staged Alert *) 

{$SIFC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
PROCEDURE TinsertionPoint. FinishPaste(clipSelection: TSelection; pic: PicHandle) 
VAR clipTextSelection: TMultiParaSel ection; 
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BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
IF InClass(clipSelection, TMultiParaSelection) THEN 
BEGIN 
clipTextSelection := TMultiParaSelecti on(cli pSel ection) 
SELF.I nsertText(clipTextSelection.textIl mage.text, clipTextSelection.isParaSel ection, 
clipTextSelection.isWordSel ection, 
END 
IFC fUseUni vText } 
SE IF clipBoard. hasUniversal Text THEN 
SELF.InsertText(NIL, FALSE, FALSE, TRUE) 
{$ENDC}; 


{$ 
EL 


{$1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TinsertionPoint.I dl eBegin(centiSeconds: LONGI NT); 
{Assumes highlighting is already on} 
BEGIN 
{$I1FC fTrace}BP( 6); {$ENDC} 
1F (SELF. kind = nothingKind) OR SELF.isParaSelection THEN 
SELF. nextHighTransit := hNone 
ELSE 
BEGIN 
SELF.textl mage. text. HiliteRange(hOnToOff, SELF.textRange, FALSE) 
SELF. nextHighTransit := hOffTOOn; 
SELF. nextTransitTime := centiSeconds+blinkOffTi me; 
END; 
SUPERSELF.1 dl eBegi n(centi Seconds) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TinsertionPoint.| dl eContinue(centiSeconds: LONGI NT) 
BEGIN 
{$I FC fTrace}BP(6); {$ENDC} 
IF (SELF. nextHighTransit<>hNone) AND (centiSeconds > SELF. nextTransitTime) THEN 


BEGIN 
SELF.textl mage. text. HiliteRange(SELF.nextHighTransit, SELF. textRange, FALSE) 
WITH SELF DO 

1F nextHighTransit = hOnToOff THEN 


BEGIN 
nextHighTransit : 
nextTransitTime : 


hOf f ToOn; 
centi Seconds +bl i nkOffCenti Secs: 
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000858 
000859 


END 
ELSE 
BEGI 


nextHighTransit : 
nextTransitTime : 


END; 
END; 
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N 
hOnToOff: 
C 


SUPERSELF. 1 dl eConti nue(centi Seconds): 


{$1 FC fTrace}EP 
END; 


SgTxt Hot } 


{$ENDC} 


PROCEDURE TinsertionPoi nt. I dl eEnd(centi Seconds: 


{ end with highl 
BEGIN 


ighting on } 


{$1FC fTrace}BP( 6); {$ENDC} 
[F SELF. next HighTransit=hOffToOn THEN 


SELF. text! mage. text. HiliteRange(hOffToOn, 


SELF. nextHighTransit := hNone 
SUPERSELF.1 dl eEnd(centi Seconds) ; 


{$I FC fTrace}EP 
END; 


SgTxt Cl d} 


PROCEDURE TinsertionPoint.InsertText(text: 


VAR s: 
prevPara: 
newPara: 
aParagraph: 
newLP: 
text! mage: 
insertlt: 
done: 
newParal mage: 
paral ndex: 
delta: 
numParas: 
needSpRi ght: 


{$ENDC} 


TListScanner; 
TEdit Para; 
TEdit Para; 
TEdit Para; 
| NTEGER; 
TTextl mage; 
BOOLEAN; 
BOOLEAN; 
TParal mage; 
LONGI NT; 
INTEGER; 
INTEGER; 
BOOLEAN; 


{$I FC fUseUni vText } 


readUnivText: 
univPara: 
univFormat: 
{$ENDC} 


TTKReadUni vText; 
TEdit Para; 
TParaFor mat; 


PROCEDURE Start Paste 
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enti Seconds tbl i nkOnCenti Secs 


SELF. textRange, 


TText; isParaSel ection: 


isWordSel ection: 


universal Text: 
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000860 BEGIN 

000861 {$1 FC fTrace}BP(10); {$ENDC} 

000862 IF universal Text THEN 

000863 BEGIN 

000864 {$1 FC fUseUni vText} 

000865 univFormat := TParaFormat. CREATE(NIL, SELF.Heap, SELF. textI mage. text. styl eSheet); 
000866 univPara := textl mage. NewEditPara(0, prevPara. format); 
000867 readUnivText := TTKReadUnivText. CREATE(NIL, SELF. Heap, NIL, 512, 
000868 [UTCharacters, UTParagraphs]); 
000869 numParas := 0; 

000870 {$ENDC} 

000871 END 

000872 ELSE 

000873 BEGIN 

000874 numParas := text. paragraphs.size 

000875 s := text. paragraphs. Scanner 

000876 END; 

000877 {$1 FC fTrace}EP; {$ENDC} 

000878 END; 

000879 

000880 PROCEDURE EndPaste 

000881 BEGIN 

000882 {$I FC fTrace}BP(10); {$ENDC} 

000883 IF universal Text THEN 

000884 BEGIN 

000885 {$I FC fUseUni vText} 

000886 uni vPara. Free; 

000887 readUnivText. Free 

000888 {$ENDC} 

000889 END; 

000890 {$I FC fTrace}EP; {$ENDC} 

000891 END; 

000892 

000893 FUNCTION Get Paragraph( VAR paragraph: TEditPara): BOOLEAN 
000894 VAR currPos: INTEGER 

000895 done: BOOLEAN; 

000896 runSize: INTEGER; 

000897 wasSomeText: BOOLEAN; 

000898 ch: CHAR; 

000899 typeStyle: TTypeStyle; 

000900 BEGIN 

000901 {$1 FC fTrace}BP(10); {$ENDC} 

000902 lf universal Text THEN 

000903 BEGIN 

000904 {$1 FC fUseUni vText} 

000905 univPara. Repl PString(0, univPara. Size, NIL) 
000906 currPos := 0; 

000907 wasSomeText := FALSE; 
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000908 done := FALSE; 

000909 REPEAT 

000910 readUni vText. ReadRun; 

000911 runSize := readUnivText. data. size 

000912 IF runSize > 0 THEN 

000913 BEGIN 

000914 IF NOT wasSomeText THEN 

000915 BEGIN 

000916 WITH univFormat, readUnivText. paragraphDescriptor DO 

000917 BEGIN 

000918 firstIndent := firstLineMargin; 

000919 leftindent := bodyMargin; 

000920 (* Can't use this because it's given as distance fromleft rather than 
000921 indent fromright and | don't know what value of right edge of paper is. 
000922 rightI ndent := rightMargin; 

000923 * 

000924 spaceBelowPara := paraLeading 

000925 END; 

000926 univPara. format := univFormat 

000927 END; 

000928 wasSomeText := TRUE; 

000929 ch := readUnivText. data, At(runSi ze) 

000930 IF ORD(ch) = ascReturn THEN 

000931 BEGIN 

000932 readUni vText. data. Del At(runSi ze) 

000933 runSize := runSize - 1; 

000934 numParas := numParas + 1; 

000935 done := TRUE; 

000936 END; 

000937 univPara. Repl TString(currPos, 0, readUnivText.data, 0, runSize); 
000938 typeStyle.onFaces := readUnivText.characterDescriptor.face 
000939 typeStyle.font.fontFamly := uvFont[readUnivText. characterDescri ptor.font].fontFamil y; 
000940 typeStyle.font.fontSize := uvFont[readUnivText.characterDescriptor.font].fontSize 
000941 univPara. NewStyle(currPos, currPostrunSize, typeStyle) 

000942 currPos := currPos + runSize 

000943 END 

000944 ELSE 

000945 BEGIN 

000946 IF wasSomeText THEN 

000947 numParas := numParas + 1; 

000948 done := TRUE; 

000949 END; 

000950 UNTIL done; 

000951 IF wasSomeText THEN 

000952 paragraph := univPara 

000953 LSE 

000954 paragraph := NIL; 

000955 Get Paragraph := wasSomeText; 
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{$ELSEC} 
paragraph := NIL; 
Get Paragraph : = FALSE; 
{$ENDC} 
END 

ELSE 
Get Paragraph := s.Scan(paragraph); 

{$I FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE I nsText; 

BEGIN 
{$1 FC fTrace}BP(10); {$ENDC} 
delta := 0: 
textl mage := SELF. textl mage 
newLP := SELF. textRange.firstLP 


newPara := SELF.textRange. first Para; 
prevPara := newPara; 
insertit := FALSE; 


1F isWordSelection THEN 
BEGIN 
needSpRi ght := newPara. Qualifies(newLP) 
IF newPara. Qualifies(newLP-1) THEN 


BEGIN 

newPara.InsertOneChar(' ', newLP); 
newLP := newLP + 1; 

delta := 1: 

END; 


END; 


{special case: if first paragraph in text is designated a whole paragraph (by isParaSelection) AND 
if the insertion point (SELF) is at the end of the paragraph then we want to make a new 

paragraph rather than append it to the current paragraph and consequently set the flag that 

was supposed to prevent the first paragraph from being inserted} 

IF isParaSelection AND (prevPara.size = newLP) THEN 


BEGIN 
newPara := textI mage. NewEditPara(0, prevPara. format) 
newLP := 0; 
insertlt := TRUE; 
END; 
done := FALSE; 


Start Paste; 

|F GetParagraph(aParagraph) THEN 
BEGIN 
delta := delta + aParagraph. size 
REPEAT 
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newPara. Repl Para(newLP, 0, aParagraph, 0, aParagraph. size); 
newLP := newLP + aParagraph. size 
1F insertlt THEN 

textl mage. text. I nsParaAfter(prevPara, newPara); 
insertlt := TRUE: 


prevPara := newPara; 
1F GetParagraph(aParagraph) THEN 
BEGIN 


newPara := textl mage. NewEdit Para( prevPara. size-newLP 
TParaFormat(aParagraph. format. Cl one( SELF. Heap) )); 

{For now, so we don't get garbage (if aParagraph later deleted), put cloned 

format on to styleSheet list} 

SELF. text! mage. text.styleSheet. formats. | nsLast(newPara. format) 

newPara. Start Edit(newPara. GrowSi ze); 

newPara. Repl Para(0, 0, prevPara, newLp, prevPara.size - newLp) 

prevPara. Repl PString(newLp, prevPara.size-newLP, NIL); 

prevPara, StopEdit; 


newLP := 0; 
END 
ELSE 
done := TRUE; 
UNTIL done: 
END; 
isParaSelection THEN 
BEGIN 
newPara := textl mage. NewEditPara(prevPara.size - newLP, prevPara. format); 


newPara, StartEdit(newPara. GrowSi ze); 

newPara. Repl Para(0, 0, prevPara, newLp, prevPara.size - newlp); 
prevPara. Repl PString(newLp, prevPara.size - newLP, NIL) 

prevPara. StopEdit; 

textl mage.text.InsParaAfter(prevPara, newPara); 

newPara := TEditPara(textl mage. text. paragraphs. At(SELF.textRange.firstIindex + numParas)); 
numParas := numParastl; 

newLP := 0; 

END 


ELSE IF isWordSelection THEN 


IF needSpRight THEN 


BEGIN 
newPara.InsertOneChar(' ', newLP); 
newLP := newLP + 1; 
delta := delta + 1; 
END: 
EndPaste; 


{$1 FC fTrace}EP; {$ENDC} 
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PROCEDURE Adj ust; 
PROCEDURE AddDelta( paral mage: TParal mage); 
BEGIN 
paral mage. Adj ustLineLPs(SELF.textRange.firstLP, delta); 
BEGIN 
{$1 FC fTrace}BP(10); {$ENDC} 
SELF. text Range. first Para. Eachl mage( AddDel ta); 


WITH SELF, textRange DO 


BEGIN 
firstPara := newPara; 
lastPara := newPara; 


firstLP := newLP; 

lastLP := newLP; 

firstindex := firstlndex + numParas - 1: 
lastIndex := firstindex; 


newestLP := newLP; 
amTyping := FALSE; 
END; 


{$1 FC fTrace}EP; {$ENDC} 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
IF (text <> NIL) OR universal Text THEN 
SELF. ChangeText(InsText, Adjust); 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot } 
PROCEDURE TinsertionPoi nt.KeyBack(f Word: BOOLEAN); 


VAR paragraph: TEdit Para; 
savedPara: TEdit Para; 
Ip: INTEGER; 
typi ngCmd: TTypi ngCmd; 
prevPara: TEdit Para: 
text Range: TText Range 


PROCEDURE Adj ust; 
VAR c: CHAR; 


PROCEDURE Del One( paral mage: TParal mage); 
BEGIN 
paral mage. Adj ustLineLPs(Ip, -1) 
BEGIN 
{$I FC fTrace}BP(10); {$ENDC} 


Apple Lisa ToolKit 3.0 Source Code Listing 


879 of 


1012 


001100 
001101 
001102 
001103 
001104 
001105 
001106 
001107 
001108 
001109 
001110 
001111 
001112 
001113 
001114 
001115 
001116 
001117 
001118 
001119 
001120 
001121 
001122 
001123 
001124 
001125 
001126 
001127 
001128 
001129 
001130 
001131 
001132 
001133 
001134 
001135 
001136 
001137 
001138 
001139 
001140 
001141 
001142 
001143 
001144 
001145 
001146 
001147 


Apple Lisa Computer Technical Information 


paragraph := SELF. textRange.first Para; 
Ip := SELF. newestLP 


1F fWord THEN 
{&&& Move textRange.firstLP back to start of word}; 


paragraph. BeginInsertion(Ip, 0); 


1F (paragraph. holeStart < 1) AND (SELF. textRange.firstlndex = 1) THEN 
SELF. Cant Dolt 
ELSE 
BEGIN 
prevPara := NIL; 
[F paragraph. holeStart < 1 THEN 
BEGIN 
{Backspacing over beginning of paragraph} 
textRange := SELF. textRange 
textRange.firstindex := textRange.firstIndex - 1; 
prevPara := TEditPara(SELF.textl mage.text. paragraphs. At(textRange. first! ndex)); 
WITH textRange DO 
BEGIN 
firstPara := prevPara; 
firstLP := prevPara.size 
lastindex := firstIndex; 
lastPara := firstPara: 
lastLP := firstLP 
SELF. newestLP := firstLP 
END; 
prevPara. Repl Para(prevPara.size, 0, paragraph, 0, paragraph. size); 
SELF. text! mage. text. Del Para( paragraph, FALSE); 
SELF. text! mage. text. paragraphs. Del Object(paragraph, FALSE) 
END 
ELSE 
BEGIN 
paragraph. bsCount := paragraph. bsCount + 1; 
C := paragraph, At( paragraph. hol eStart) ; 
paragraph. Del At( paragraph. hol eStart); 


paragraph. UpdateRuns(Ip-1, 1, 0); 
SELF. newestLP := Ip-1; 
END; 


typingCmd := SELF. typi ngCmd; 
IF prevPara = NIL THEN 
BEGIN 
typingCmd. newCharCount := typingCmd.newCharCount - 1; 
IF typingCmd. newCharCount < 0 THEN 
BEGIN 
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typingCmd.typingRange.firstLP := typingCmd.typingRange.firstLP - 1; 


typingCmd. newCharCount := 0; 


savedPara := TEditPara(typingCmd. savedText. paragraphs. First); 


{$R- } 
savedPara.InsertOneChar(c, 0); 
{$1 FC fRngText}{$R+}{$ENDC} 
END; 
END 
ELSE 
BEGIN 
typingCmd. newParaCount := typingCmd.newParaCount - 1; 
1F typingCmd. newParaCount < 0 THEN 
BEGIN 


typingCmd.typingRange.firstIndex := textRange.firstI ndex; 
typingCmd.typingRange.firstPara := textRange. first Para; 


typingCmd.typingRange.firstLP := textRange.firstLP 
typingCmd, savedText. paragraphs. I nsFirst( paragraph) 
paragraph. Repl PString(0, paragraph.size, NIL); 
typingCmd. newCharCount : 
typingCmd. newParaCount : 
END 

ELSE 
paragraph. Free 

END; 


= 0; 
= 0; 


deferUpdate := TRUE; 
SELF.justReturned : = FALSE; 
END; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


BEGIN 
{$IFC fTrace}BP( 10); {$ENDC} 
SELF. KeyText; 
Adj ust; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TinsertionPoi nt. KeyChar(ch: CHAR) 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. KeyText; 


SELF.textRange.firstPara.InsertOneChar(ch, SELF. newestLP) 
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1F SELF.styleCmdNumber <> 0 THEN 
BEGIN 


SELF. textRange. first Para. NewStyle(SELF. newestLP, SELF. newestLP+1, SELF. currTypeStyl e) 


SELF. styl eCmdNumber := 0; 


END; 
WITH SELF. typingCmd DO 
newCharCount := newCharCount + 1; 


SELF. newestLP := SELF.newestLP + 1; 
SELF.justReturned : = FALSE; 
{$IFC fTrace}EP; {$ENDC} 

END: 


{$$ SgTxtCld} 

PROCEDURE TinsertionPoi nt. KeyEnter 

BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. text! mage. text. Recomputel mages 
(*SELF.textl mage. text. I nvali date; *) 
deferUpdate := FALSE; 
{$1FC fTrace}EP; {$ENDC} 


END; 
{$$ SgTxtCld} 
PROCEDURE TinsertionPoi nt. KeyForward(fWord: BOOLEAN); 
VAR paragraph: TEdit Para; 
savedPara: TEdit Para; 


Ip: INTEGER; 


{NOTE: This first stab at KeyForward does NOT properly restore typestyles !!} 
PROCEDURE Adj ust; 


PROCEDURE AddOne( paral mage: TParal mage); 
BEGIN 
paral mage. Adj ustLineLPs(Ip, 1); 
BEGI N 
paragraph := SELF. textRange. first Para; 
Ip := SELF. newestLP 


IF (Ip = paragraph. holeStart) AND (paragraph. bsCount > 0) THEN 
BEGIN 


IF f Word THEN 
{&&& Recover word}; 
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WITH paragraph DO 


BEGIN 

bsCount := paragraph. bsCount - 1; 
holeStart := paragraph. holeStart + 1; 
holeSize := paragraph. holeSize - 1; 
size := size + 1: 

END; 


paragraph. UpdateRuns(Ip-1, 0, 1); 
SELF. newestLP := Iptl; 


WITH SELF. typingCmd DO 


newCharCount := newCharCount + 1; 


deferUpdate := TRUE; 
E ' 


SELF.justReturned := FALSE; 


END; 


BEGIN 


{$l FC fTrace}BP( 10); {$ENDC} 
SELF. KeyText; 


Adjust; 


{$I1FC fTrace}EP; {$ENDC} 


END; 


{$$ SgTxtHot} 


PROCEDURE TinsertionPoi nt. KeyPause 


{Called by Tool 
VAR text: 
diff: 
Ip: 
text! mage: 
paral mage: 
startLine: 
startPixel: 


Kit when there are no keystrokes pending} 
TText; 

| NTEGER; 

| NTEGER; 

TTextl mage; 

TParal mage; 

| NTEGER; 

LONGI NT; 


PROCEDURE AddDiff(paral mage: TParal mage); 


BEGIN 


paral mage. AdjustLineLPs(Ip, diff); 


PROCEDURE Adj ustOtherI nsPts(obj: TObj ect); 
VAR insertPt: Tl nsertionPoi nt; 


BEGIN 


insertPt := Tl nsertionPoi nt( obj); 
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paral mage := insertPt.textl mage. | mageWith(SELF.textRange.firstPara, Ip) 
IF paralmage <> NIL THEN 
BEGIN 
paral mage. LocateLP(Ip, startLine, startPixel); 
insertPt.textl mage. firstLinePixel := startPixel 
insertPt, textl mage.useFirst Pixel := TRUE; 
END 
ELSE 
insertPt. textl mage.useFirstPixel := FALSE; 


WITH SELF, insertPt.textRange DO 
BEGIN 
firstLP := newestLP 
lastLP := newestLP; 
IF firstlndex <> textRange.firstlndex THEN 
BEGIN 
firstIndex := textRange. first! ndex; 


lastIlndex := textRange. last! ndex; 
firstPara := textRange.firstPara; 
lastPara := textRange.lastPara; 
END; 

END; 


END; 


PROCEDURE HiliteOtherl nsPts(obj: TObj ect); 
VAR insertPt: TI nsertionPoint; 
BEGIN 
insertPt := Tl nsertionPoi nt (obj); 
IF insert Pt. view. OKToDrawi n(insertPt. text! mage. extentLRect) THEN 
insertPt. panel. Highlight(insertPt, hOffToOn) 
END; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
[F SELF.amTyping AND NOT SELF.justReturned THEN 


BEGIN 
textl mage := SELF. textl mage 
text := textl mage. text; 


diff := SELF.newestLP - SELF. textRange.firstLP 
Ip := Min(SELF.textRange.firstLP, SELF. newestLP) 
SELF. MarkChanged 

SELF. text Range. first Para. Eachl mage( AddDiff); 


{set up textl mage fields for minimum rectangle erase of first update line} 
paral mage := text! mage.| mageWith(SELF.textRange.firstPara, Ip); 
IF paralmage <> NIL THEN 


BEGIN 
paral mage. LocateLP(Ip, startLine, startPixel); 
textl mage. firstLinePixel := startPixel 
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001340 textl mage. useFirstPixel := TRUE; 

001341 END 

001342 ELSE 

001343 textl mage. useFirstPixel := FALSE; 

001344 

001345 SELF.textRange.firstLP := SELF. newestLP 

001346 SELF.textRange.lastLP := SELF. newestLP 

001347 IF SELF. typingCmd <> NIL THEN 

001348 1F SELF. typingCmd. otherlnsPts <> NIL THEN 

001349 SELF. typingCmd. otherlnsPts. Each( Adj ust Otherl nsPts) 
001350 

001351 text. Recomputel mages; 

001352 

001353 {lf view. OKToDrawln was TRUE then we won't be going through the update cycle and hence the 
001354 Tool Kit won't tell us to highlight, so we'll have to highlight ourselves} 
001355 IF SELF. view. OKToDrawin(SELF.textIl mage. extentLRect) THEN 
001356 SELF. panel. Highlight(SELF, hOffToOn); 

001357 |F SELF.typingCmd <> NIL THEN 

001358 [F SELF. typingCmd.otherlnsPts <> NIL THEN 

001359 SELF. typingCmd. otherlnsPts. Each(HiliteOtherl nsPts) 
001360 END; 

001361 deferUpdate := FALSE; 

001362 SELF.justReturned : = FALSE; 

001363 {$I1FC fTrace}EP; {$ENDC} 

001364 END; 

001365 

001366 

001367 {$8 SgTxt Wrm} 

001368 PROCEDURE TinsertionPoi nt. KeyReturn; 

001369 VAR paral: TEditPara 

001370 newPara: TEditPara 

001371 sel Size: INTEGER 

001372 

001373 PROCEDURE I nsPara; 

001374 VAR styleChange: TStyl eChange 

001375 BEGIN 

001376 {$1 FC fTrace}BP( 10); {$ENDC} 

001377 paral := SELF. textRange.firstPara; 

001378 selSize := paral.size - SELF.textRange.firstLP 

001379 newPara := SELF. textl mage. NewEditPara(selSize, paral. format); 
001380 newPara. StartEdit(newPara. GrowSi ze) 

001381 newPara. Rep! Para(0, 0, paral, SELF.textRange.firstLP, selSize) 
001382 [F TFakeTStyle(newPara.format.dfltTStyle) <> TFakeTStyle(SELF.currTypeStyle) THEN 
001383 BEGIN 

001384 styleChange.Ip :=-1 

001385 styl eChange. veweigl a. := SELF.currTypeStyle 

001386 newPara.typeStyles. PutAt(1, @styleChange); 

001387 END; 
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001388 
001389 
001390 
001391 
001392 
001393 
001394 
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001396 
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001408 
001409 
001410 
001411 
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001413 
001414 
001415 
001416 
001417 
001418 
001419 
001420 
001421 
001422 
001423 
001424 
001425 
001426 
001427 
001428 
001429 
001430 
001431 
001432 
001433 
001434 
001435 


END; 
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paral. Repl PString(SELF.textRange.firstLP, selSize, NIL); 
paral, StopEdit; 

SELF.textl mage.text. I nsParaAfter(paral, newPara); 

{$1 FC fTrace}EP; {$ENDC} 


PROCEDURE Adj ust; 


BEGI 


END; 


PROCEDURE Adj ustOtherIlnsPts(obj: TObj ect); 
VAR insertPt: Tl nsertionPoint; 
BEGIN 

insertPt := Tl nsertionPoi nt( obj); 

WITH insertPt, textRange DO 


BEGIN 
firstLP := 0; 
lastLP := 0; 
firstIlndex := SELF. textRange.firstIndex; 
lastindex := firstIndex; 
firstPara := newPara; 
lastPara := newPara; 
END: 
END; 
N 


{$1 FC fTrace}BP(10); {$ENDC} 
WITH SELF. textRange DO 


BEGIN 

firstPara := newPara; 
lastPara := newPara; 
firstindex := firstIlndex + 1; 
lastI ndex := firstindex; 
firstLP := 0; 

lastLP := 0: 

END; 


SELF. newestLP := 0: 
SELF.justReturned := TRUE; 
WITH SELF.typingCmd DO 
newParaCount := newParaCount + 1; 
[F SELF. typingCmd. otherlnsPts <> NIL THEN 
SELF. typingCmd, otherI nsPts. Each( Adj ust Otherl nsPts) 
deferUpdate := FALSE; 
SELF.textl mage. useFirstPixel := FALSE; 
{$1 FC fTrace}EP; {$ENDC} 


PROCEDURE HiliteOtherI nsPts(obj: TObj ect); 


VAR 
BEGI 


insertPt: TI nsertionPoi nt; 
N 


insertPt := Tl nsertionPoi nt (obj); 
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001436 IF insert Pt. view. OKToDrawi n(insertPt. text! mage. extentLRect) THEN 
001437 insertPt. panel. Highlight(insertPt, hOffToOn) 
001438 END; 

001439 

001440 BEGIN 

001441 {$1FC fTrace}BP(10); {$ENDC} 

001442 SELF. KeyText; 

001443 SELF. ChangeText(InsPara, Adjust); 

001444 {lf view. OKToDrawln was TRUE then we won't be going through the update cycle and hence the 
001445 Tool Kit won't tell us to highlight, so we'll have to highlight ourselves} 
001446 IF SELF. view. OKToDrawl n( SELF. textl mage. extentLRect) THEN 
001447 SELF. panel. Highlight(SELF, hOffToOn) 

001448 [F SELF.typingCmd. otherlnsPts <> NIL THEN 

001449 SELF. typingCmd. otherlnsPts. Each(HiliteOtherl nsPts) 
001450 {$1FC fTrace}EP; {$ENDC} 

001451 END; 

001452 

001453 

001454 {$8 SgTxtCld} 

001455 PROCEDURE TinsertionPoi nt. KeyTab 

001456 BEGIN 

001457 {$1FC fTrace}BP( 10); {$ENDC} 

001458 SELF. KeyChar(' '); 

001459 {$I1FC fTrace}EP; {$ENDC} 

001460 END; 

001461 

001462 

001463 {$8 SgTxt Hot} 

001464 PROCEDURE TinsertionPoi nt. MarkChanged 

001465 BEGIN 

001466 {$I1FC fTrace}BP(10); {$ENDC} 

001467 IF SELF.newestLP < SELF.textRange.firstLP THEN 

001468 BEGIN 

001469 SELF.textRange.firstLP := SELF. newestLP 

001470 SELF.textRange.|astLP := SELF. newestLP 

001471 SUPERSELF. Mar kChanged 

001472 END 

001473 ELSE 

001474 BEGIN 

001475 SUPERSELF. MarkChanged 

001476 SELF.textRange.firstLP := SELF. newestLP 

001477 SELF.textRange.lastLP := SELF. newestLP 

001478 END; 

001479 {$1FC fTrace}EP; {$ENDC} 

001480 END: 

001481 

001482 


001483 {$8 SgTxtHot} 
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001484 PROCEDURE TinsertionPoi nt. MouseMove(mouseLPt: LPoint); 

001485 VAR currPl mage: TParal mage 

001486 currLP: INTEGER; 

001487 multi ParaSelection: TMultiParaSel ection; 

001488 oneParaSel ection: TOneParaSel ection: 

001489 textl mage: TTextl mage; 

001490 firstTxtl mg: TTextl mage; 

001491 paral ndex: LONGI NT; 

001492 wasParaSel: BOOLEAN 

001493 

001494 BEGIN 

001495 {$1 FC fTrace}BP( 10); {$ENDC} 

001496 SELF.currLPt := mouseLPt; 

001497 IF NOT Equal LPt(mouseLPt, SELF. anchorLPt) THEN 

001498 BEGIN 

001499 textl mage := SELF. textl mage. FindTextl mage(mouseLPt, firstTxt! mg) 

001500 textl mage. FindParaAndLp(mouseLPt, currPlmage, paralndex, currLP) 

001501 

001502 IF (currPlmage. paragraph <> SELF.textRange.firstPara) THEN 

001503 BEGIN 

001504 {Turn insertion point off if necessary} 

001505 wasParaSel := SELF.isParaSel ection; 

001506 1F NOT wasParaSel AND (paralndex > SELF.textRange.firstIlndex) THEN 
001507 SELF. text! mage. text. HiliteRange(hOnToOff, SELF.textRange, FALSE) 
001508 {call new with same paragraph, followed by MouseMove so highlighting will work correctly 
001509 and so MouseMove can figure out if currPl mage is before of after SELF. textRange. first Para} 
001510 WITH SELF, textRange DO 

001511 {$H-} {ought to be safe: no VAR params, etc} 

001512 mul ti ParaSelection := TMulti ParaSel ection( SELF. FreedAndRepl acedBy( 
001513 TMul ti ParaSelection, CREATE( NIL, SELF. Heap 
001514 view, firstTxtlmg, anchorLPt, 

001515 firstPara, firstIndex, firstLP 

001516 firstPara, firstlndex, firstLP, TRUE))); 
001517 {$H+} 

001518 multi ParaSelection.isParaSelection := wasParaSel 

001519 mul ti ParaSel ection. MouseMove( mouseLPt ) 

001520 END 

001521 ELSE |F (currLP <> SELF.textRange.firstLP) THEN 

001522 BEGIN 

001523 {Turn insertion point off first} 

001524 SELF.textl mage. text. HiliteRange(hOnToOff, SELF.textRange, FALSE) 
001525 {call CREATE with same LP for begin and end 

001526 followed by MouseMove so highlighting will work correctly} 

001527 WITH SELF, textRange DO 

001528 {$H-} {ought to be safe: no VAR params, etc} 

001529 oneParaSelection := TOneParaSel ecti on(SELF. FreedAndRepl acedBy( 
001530 TOneParaSelection. CREATE(NIL, SELF. Heap, 
001531 view, firstTxtl mg, anchorLPt, 
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001532 
001533 
001534 
001535 
001536 
001537 
001538 
001539 
001540 
001541 
001542 
001543 
001544 
001545 
001546 
001547 
001548 
001549 
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001551 
001552 
001553 
001554 
001555 
001556 
001557 
001558 
001559 
001560 
001561 
001562 
001563 
001564 
001565 
001566 
001567 
001568 
001569 
001570 
001571 
001572 
001573 
001574 
001575 
001576 
001577 
001578 
001579 
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firstPara, firstIlndex, firstLP, firstLP))); 
{$H+} 
oneParaSel ection. MouseMove( mouseLPt); 
END: 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Wrm} 
PROCEDURE Ti nsertionPoi nt. MousePress(mouseLPt: LPoint); 


VAR first, last: INTEGER 
oneParaSel ection: TOneParaSel ection: 
funnnyl ns Poi nt: Tl nsertionPoi nt; 
BEGIN 


{$1FC fTrace}BP( 10); {$ENDC} 
IF clickState.fShift THEN 
SELF. MouseMove( mouseLPt ) 
ELSE IF clickState.clickCount = 2 THEN {double click} 
BEGIN 
{This check should solve the problem of double clicking on the last half of the last 
character of a word and not getting the word selected} 
WITH SELF. textRange DO 
BEGIN 
first := firstLP; 
{$H- } 
IF NOT firstPara,. Qualifies(first) THEN 
IF first > 0 THEN 
first := first - 1: 
{$H+} 


END; 
SELF.textRange.firstPara. FindWordBounds(first, first, last); 
IF first <> last THEN 
BEGIN 
{Turn insertion point off first} 
SELF. textl mage. text. HiliteRange(hOnToOff, SELF. textRange, FALSE) 
WITH SELF, textRange DO 
{$H- } 
oneParaSelection := TOneParaSel ecti on( SELF. FreedAndRepl acedBy( 
TOneParaSel ection. CREATE(NIL, SELF. Heap, 
view, textIl mage, anchorLPt, 
firstPara, firstIndex, first, last))); 


{$H+} 

WITH oneParaSelection DO 
BEGIN 
anchorbegin := first 
anchorEnd := last; 


isWordSelection := TRUE; 


Apple Lisa ToolKit 3.0 Source Code Listing -- 889 of 1012 


001580 
001581 
001582 
001583 
001584 
001585 
001586 
001587 
001588 
001589 
001590 
001591 
001592 
001593 
001594 
001595 
001596 
001597 
001598 
001599 
001600 
001601 
001602 
001603 
001604 
001605 
001606 
001607 
001608 
001609 
001610 
001611 
001612 
001613 
001614 
001615 
001616 
001617 
001618 
001619 
001620 
001621 
001622 
001623 
001624 
001625 
001626 
001627 


Apple Lisa Computer Technical Information 


END; 
oneParaSelection.textl mage.text. HiliteRange(hOffToOn, oneParaSelection.textRange, FALSE); 
END; 


EN 
ELSE IF clickState.clickCount = 3 THEN {triple click, happens if double click didn't select word} 
BEGIN 
{Turn insertion point off first} 
SELF.textl mage. text. HiliteRange(hOnToOff, SELF.textRange, SELF.isParaSel ection) 


[F SELF.textRange.firstPara.size = 0 THEN 
{This case precipitates the odd notion of an “insertion point" the width of the textl mage; 
(ie. when one triple clicks on an empty paragraph) A special check in IdleBegin makes sure 
it doesn't blink. } 
BEGIN 
WITH SELF, textRange DO 
{$H- } 
funnnyl nsPoint := TinsertionPoint( SELF. FreedAndRepl acedBy( 
Ti nsertionPoint. CREATE( NIL, SELF. Heap, 
view, textIl mage, anchorLPt, 
firstPara, firstIlndex, 0))); 


{$H+} 

WITH funnnylnsPoint DO 
BEGIN 
isParaSelection := TRUE; 
isWordSelection := FALSE; 
END; 

funnnyl nsPoint.textl mage. text. HiliteRange(hOffToOn, SELF.textRange, TRUE) 

END 

ELSE 

BEGIN 

WITH SELF, textRange DO 
{$H- } 


oneParaSelection := TOneParaSel ecti on(SELF. FreedAndRepl acedBy( 
TOneParaSel ection, CREATE(NIL, SELF. Heap 
view, textl mage, anchorLPt, 
firstPara, firstIndex, 0, firstPara.size))); 


{$H+} 

WITH oneParaSelection DO 
BEGIN 
isParaSelection := TRUE; 
isWordSelection := FALSE; 


anchorBegin := 0; 
anchorEnd := textRange.lastLP 
END; 
oneParaSelection.textl mage.text. HiliteRange(hOffToOn, oneParaSelection.textRange, TRUE) 
END; 
END 
ELSE 
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001628 SELF. textl mage. MousePress(mouseLPt); 

001629 {$1FC fTrace}EP; {$ENDC} 

001630 END: 

001631 

001632 

001633 {$8 SgTxtCld} 

001634 FUNCTION TI nsertionPoint. NewStyleCmd( heap: THeap; cmdNumber: TCmdNumber; 
001635 textl mage: TTextl mage): TCommand; 
001636 BEGIN 

001637 {$IFC fTrace}BP( 10); {$ENDC} 

001638 {Do stuff but set NewStyleCmd NIL so last cmd not committed}; 
001639 SELF.styleCmdNumber : = cmdNumber; 

001640 WITH SELF.currTypeStyle, font DO 

001641 CASE cmdNumber OF 

001642 uPl ain: 

001643 onFaces := [];} 

001644 uBol d: 

001645 onFaces := onFaces + [bold]; 

001646 ultalic: 

001647 onFaces := onFaces + [italic]; 

001648 uUnderline: 

001649 onFaces := onFaces + [underlined]; 

001650 uShadow: 

001651 onFaces := onFaces + [Shadow]; 

001652 uOutline: 

001653 onFaces := onFaces + [outline]; 

001654 uModern, uClassic: 

001655 font. fontFamily := cmdNumber - uModern + 1; 
001656 

001657 {$1FC LibraryVersion <= 20} 

001658 uFnt0, uFntl, uFnt2, uFnt3, uFnt4, uFnt5, uFnt6, uFnt7, uFnt8, uFnt9, uFnt10, uFntll: 
001659 CASE cmdNumber OF 

001660 uFnt0: fontFamily := famSystem; 
001661 uFntl: 

001662 BEGIN 

001663 fontFamily := famModern; 

001664 fontSize := sizel5Pitch; 

001665 END; 

001666 uFnt2: 

001667 BEGIN 

001668 fontFamily := famModern; 

001669 fontSize := sizel2Pitch; 

001670 END; 

001671 uFnt3: 

001672 BEGIN 

001673 fontFamily := famClassic; 

001674 fontSize := sizel2Pitch; 

001675 END; 
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uFnt4: 
BEGIN 
f ont Family 
fontSize := 
END; 

uFnt5: 
BEGIN 
f ont Fami | y 
fontSize := 
END; 

uFnt6: 
BEGIN 
f ont Family 
fontSize := 
END; 

uFnt7: 
BEGIN 
f ont Fami | y 
fontSize := 
END; 

uF nts: 
BEGIN 
f ont Family 
fontSize := 
END; 

uFnt9: 
BEGIN 
f ont Family 
fontSize := 
END; 

uFnt10: 
BEGIN 
f ont Fami | y 
fontSize := 
END; 

uFntll: 
BEGIN 
f ont Fami | y 
fontSize := 
END; 

END; 

{$ENDC} 


OTHERW SE 


font. fontSize := cmdNumber - 


END; 
NewStyleCmd := NIL; 
{$IFC fTrace}EP; {$ENDC} 
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:= famModern; 


sizelQPitch: 


:= famModern; 


sizel4Point; 


:= famModern; 


sizel2Point; 


:= famClassic: 


sizel2Point; 


:= famModern; 


sizel8Poi nt; 


:= famClassic: 


sizel8Point; 


:= famModern; 


size24Poi nt: 


:= famClassic: 


size24Point: 


u20Pitch + 1; 


892 of 1012 


001724 
001725 
001726 
001727 
001728 
001729 
001730 
001731 
001732 
001733 
001734 
001735 
001736 
001737 
001738 
001739 
001740 
001741 
001742 
001743 
001744 
001745 
001746 
001747 
001748 
001749 
001750 
001751 
001752 
001753 
001754 
001755 
001756 
001757 
001758 
001759 
001760 
001761 
001762 
001763 
001764 
001765 
001766 
001767 
001768 
001769 
001770 
001771 


{$8 


{$8 


{$$ 


{$S 


Apple Lisa Computer Technical Information 


END; 


SgTxt Cl d} 
FUNCTION TI nsertionPoint. NewCutCopyCmd( heap: THeap; cmdNumber: TCmdNumber 
textl mage: TTextl mage): TCommand 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
{don't create a new command object for insertion point style change} 
NewCutCopyCmd := NIL; 
{$1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 
FUNCTION Tl nsertionPoint. Sel Size: INTEGER 
BEGIN 
{$IFC fTrace}BP( 9); {$ENDC} 
SelSize := 0; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Hot } 
PROCEDURE TinsertionPoi nt. StyleFromContext 
VAR typeStyle: TTypeSTyl e; 
BEGIN 
{$1FC fTrace}BP( 9); {$ENDC} 
SELF. textRange. firstPara. Styl eAt( Max(SELF.textRange.firstLP - 1, 0), typeStyle); 
SELF. currTypeStyle := typeStyle; 
{$1FC fTrace}EP; {$ENDC} 
END; 


SgTxtl ni } 


BEGIN 


{temp patch to get fonts fromuniversal text} 
uvFont[4].fontFamily := famModern; 

uvFont[5].fontFamily := famModern; 
uvFont[6].fontFamily := famModern; 
uvFont[7].fontFamily := famModern; 
uvFont[8].fontFamily := famModern; 


uvFont[9].fontFamily := famModern; 

uvFont[10].fontFamily := famClassic; 
uvFont[11].fontFamily := famClassic; 
uvFont[12].fontFamily := famClassic; 
uvFont[13].fontFamily := famClassic; 
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uvFont[14].fontFamily := famClassic; 
uvFont[4].fontSize : 
uvFont[5].fontSize : 
uvFont[6].fontSize : 
uvFont[7].fontSize : 
uvFont[8].fontSize : 
uvFont[9].fontSize : 
uvFont[10].fontSize := 
uvFont[11].fontSize := 
uvFont[12].fontSize := 
uvFont[13].fontSize := 
uvFont[14].fontSize := 
END; {Methods of Tlnsertion 


PWN o~ UO 


US; D3 OO OES FS 


ene 


METHODS OF TOneParaSel ection; 


{$$ SgTxtHot } 
FUNCTION TOneParaSelection. CREATE( object: TObject; heap: THeap; itsView: TView; itsTextl mage: TTextl mage 
itsAnchorLPt: LPoint; itsParagraph: TEditPara; itsIlndex: LONGI NT; 
ol dLP: | NTEGER; currLP: INTEGER): TOneParaSel ection; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TOneParaSelection(TTextSelection, CREATE(object, heap, itsView, itsTextIl mage, itsAnchorLPt, 
itsParagraph, itsIndex, Min(oldLP, currLP) 
itsParagraph, itsIndex, Max(oldLP, currLP))); 


WITH SELF DO 
BEGIN 
anchorBegin := oldLP 
anchorEnd := ol dLP 
viewTick := -1; { force recalculation of extent } 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
{$l FC fTextTrace} 
PROCEDURE TOneParaSel ection. Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
TText Selection. Fields( Field); 
Field('anchorBegin: I NTEGER'); 
Field('anchorEnd: | NTEGER'); 
Field(''); 
END; 
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001820 {$ENDC} 


001821 

001822 {$8 SgTxtCld} 

001823 PROCEDURE TOneParaSel ection. ChangeStyle(cmdNumber: TCmdNumber); 

001824 VAR newTypeStyle: TTypeStyle 

001825 BEGIN 

001826 {$1FC fTrace}BP( 10); {$ENDC} 

001827 WITH SELF. textRange DO 

001828 {$H- } 

001829 SELF. DoChangeStyle(cmdNumber, firstPara, firstLP, lastLP, newTypeStyle) 
001830 {$H+} 

001831 SELF. currTypeStyle := newTypeStyle; 

001832 {$1FC fTrace}EP; {$ENDC} 

001833 END; 

001834 

001835 

001836 {$8 SgTxtCld} 

001837 {CopySelf is used for copying to the clipboard} 

001838 FUNCTION TOneParaSelection. CopySelf(heap: THeap; view: TView): TMulti ParaSel ection; 
001839 VAR paragraph: TEdit Para; 

001840 selSize: INTEGER; 

001841 newl mage: TParal mage 

001842 lastLine: TLi nel nfo; 

001843 textl mage: TTextl mage 

001844 text: TText; 

001845 imageLRect: LRect; 

001846 BEGIN 

001847 {$I FC fTrace}BP(11); {$ENDC} 

001848 text := TText.CREATE(NIL, heap, TStyl eSheet.CREATE(NIL, heap)) 

001849 imageLRect := view. extentLRect; 

001850 InsetLRect(imageLRect, cHorizMargin, cVertMargin); 

001851 textl mage := SELF. textl mage. TxtI mgForClipBoard(heap, view, imageLRect, text, TRUE) 
001852 textl mage. mi nHeight := 0; 

001853 text. txtIl mgList. I nsLast(textl! mage) 

001854 

001855 selSize := SELF.textRange.|astLP-SELF.textRange. firstLP; 

001856 paragraph := textl mage. NewEditPara(selSize, TParaFormat(SELF.textRange. first Para. format. Clone(heap))); 
001857 paragraph, Repl Para(0, 0, SELF. textRange.firstPara, SELF.textRange.firstLP, sel Size) 
001858 

001859 newl mage := textl mage. NewParal mage( paragraph, textIl mage.extentLRect, 0, 0) 
001860 textl mage. i mageList.InsLast(newl mage) 

001861 textl mage.text. paragraphs. I nsLast( paragraph); 

001862 

001863 

001864 { make view extentLRect exactly fit the lines } 

001865 textl mage. Recomputel mages(actionNone, TRUE) 

001866 WITH textl mage.extentLRect DO 

001867 view. extentLRect. bottom := bottom- top + 2 * cVertMargin; 
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CopySelf := TMultiParaSelection.CREATE(NIL, heap, view, textIl mage, zeroLPt, paragraph, 1, 
paragraph, 1, selSize, TRUE) 
{$SIFC fTrace}EP; {$ENDC} 


{$$ SgTxt Wrm} 
PROCEDURE TOneParaSel ecti on. Del eteAndFree 
VAR delta: INTEGER 


PROCEDURE Del Text; 
BEGIN 
[F SELF.isParaSelection AND 
(SELF.textRange.firstIindex <> SELF.textl mage.text. paragraphs.size) THEN 
BEGIN 
SELF.textl mage. text. Del Para(SELF.textRange.firstPara, FALSE) 
SELF. text! mage. text. paragraphs. Del Obj ect(SELF.textRange.firstPara, TRUE) 
END 
ELSE 
SELF. textRange. firstPara. Repl PString(SELF.text Range. firstLP, 
SELF. textRange.|lastLP-SELF.textRange.firstLP, NIL) 
END; 


PROCEDURE Adj ust; 
PROCEDURE Subtract(paral mage: TParal mage); 
BEGIN 
paral mage. Adj ustLineLPs(SELF.textRange.firstLP, delta); 
BEGIN 
1F NOT SELF.isParaSelection THEN 
BEGIN 
delta := SELF.textRange.firstLP - SELF. textRange.|astLP 
SELF. textRange.firstPara. Eachl mage( Subtract); 
END; 
WITH SELF. textRange DO 
BEGIN 
1F SELF.isParaSelection THEN 
BEGIN 
{$H- } 
firstPara := TEditPara(SELF.textl mage. text. paragraphs. At(firstl ndex) ) 
{$H+} 
firstLP := 0: 
lastPara := firstPara; 
END: 
lastLP := firstLP; 
END; 
END; 
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001916 BEGIN 

001917 {$I1FC fTrace}BP( 10); {$ENDC} 

001918 SELF. ChangeText(Del Text, Adjust); 

001919 {$I1FC fTrace}EP; {$ENDC} 

001920 END: 

001921 

001922 

001923 {$8 SgTxt Hot} 

001924 FUNCTION TOneParaSel ection. DeleteButSave: TText 

001925 VAR ol dPara: TEditPara 

001926 sel Size: INTEGER 

001927 newPara: TEditPara 

001928 text: TText; 

001929 PROCEDURE Del Text; 

001930 BEGIN 

001931 oldPara := SELF.textRange.firstPara 

001932 IF SELF.isParaSelection AND 

001933 (SELF.textRange.firstIindex <> SELF.textl mage.text. paragraphs.size) THEN 
001934 BEGIN 

001935 SELF.textl mage. text. Del Para(oldPara, FALSE) 

001936 SELF. text! mage. text. paragraphs. Del Obj ect(oldPara, FALSE) 
001937 newPara := oldPara; 

001938 END 

001939 ELSE 

001940 BEGIN 

001941 selSize := SELF.textRange.|astLP-SELF.textRange.firstLP 
001942 newPara := SELF. textl mage. NewEditPara(selSize, oldPara. format); 
001943 newPara. Repl Para(0, 0, oldPara, SELF.textRange.firstLP, selSize) 
001944 oldPara. Repl PString(SELF.textRange.firstLP, selSize, NIL) 
001945 END; 

001946 text := TText.CREATE(NIL, SELF.Heap, NIL); 

001947 text, paragraphs. I nsLast(newpara) 

001948 END; 

001949 

001950 PROCEDURE Adj ust; 

001951 PROCEDURE Subtract(paral mage: TParal mage); 

001952 BEGIN 

001953 paral mage. Adj ustLineLPs(SELF.textRange.firstLP, -sel Size) 
001954 END; 

001955 BEGIN 

001956 WITH SELF. textRange DO 

001957 BEGIN 

001958 IF SELF.isParaSelection THEN 

001959 BEGIN 

001960 {$H- } 

001961 firstPara := TEditPara(SELF.textl mage. text. paragraphs. At(firstl ndex) ) 
001962 {$H+} 

001963 firstLP := 0: 
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001964 lastPara := firstPara 

001965 END; 

001966 lastLP := firstLP 

001967 END; 

001968 1F NOT SELF.isParaSelection THEN 

001969 SELF.text Range. first Para. Eachl mage( Subtract); 

001970 END; 

001971 BEGIN 

001972 {$1 FC fTrace}BP( 10); {$ENDC} 

001973 SELF. ChangeText(Del Text, Adjust); 

001974 DeleteButSave := text; 

001975 {$IFC fTrace}EP; {$ENDC} 

001976 END; 

001977 

001978 

001979 {$8 SgTxt Hot} 

001980 PROCEDURE TOneParaSel ection. MouseMove(mouseLPt: LPoint); 

001981 { assumes highlighting is ON } 

001982 VAR currPl mage: TParal mage 

001983 currLP: INTEGER; 

001984 ol dLP: I NTEGER; { end (ie. not the anchor) of indication } 
001985 multi ParaSelection: TMultiParaSel ection; 

001986 textl mage: TTextl mage; 

001987 firstTxtl mg: TTextl mage; 

001988 first, last: INTEGER 

001989 paraSelect: BOOLEAN 

001990 paral ndex: LONGI NT; 

001991 

001992 PROCEDURE HiExtOnPads(highTransit: THighTransit; startLP,endLP: I NTEGER) 
001993 BEGIN 

001994 SELF.textl mage. text. HiliteParagraphs(highTransit, SELF.textRange.firstIlndex, startLP 
001995 SELF.textRange.firstIndex, endLP 
001996 SELF. isParaSel ecti on) 
001997 END; 

001998 BEGIN 

001999 {$I1FC fTrace}BP( 10); {$ENDC} 

002000 SELF.currLPt := mouseLPt; 

002001 

002002 textl mage := SELF.textl mage. FindTextl mage(mouseLPt, first Txtl mg) 

002003 textl mage. FindParaAndLp(mouseLPt, currPl mage, paralndex, currLP) 

002004 

002005 IF currPlmage.paragraph <> SELF.textRange.firstPara THEN 

002006 BEGIN 

002007 {call new with same paral mage, followed by MouseMove so highlighting will work correctly} 
002008 paraSelect := SELF.isParaSel ection; 

002009 first := SELF. anchor Begin; 

002010 last := SELF. anchorEnd; 

002011 WITH SELF, textRange DO 
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{$H- } 
multiParaSelection := TMulti ParaSel ecti on( SELF. FreedAndRepl acedBy( 
TMul tiParaSelection, CREATE(NIL, SELF. Heap, 

view, firstTxtl mg, anchorLPt, 
firstPara, firstIlndex, firstLP 
firstPara, firstIndex, lastLP, firstLP = anchorBegin))); 

{$H+} 

WITH multiParaSelection DO 

BEGIN 

isParaSelection := paraSelect; 

anchorBegin := first; 


anchorEnd := last; 
isWordSelection := NOT paraSelect AND (first <> last); 
END; 


mul ti ParaSel ection. MouseMove( mouseLPt); 


END 
ELSE IF NOT SELF.isParaSelection THEN 
BEGIN 
IF SELF.isWordSel ection THEN 
BEGIN 
{So dragging over last half of last character of word doesn't select space} 
WITH SELF.textRange DO 
BEGIN 
{$H- } 
IF NOT firstPara. Qualifies(currLP) THEN 
IF currLP > 0 THEN 
currLP := currLP - 1; 
{$H+} 


END; 
SELF.textRange.firstPara. FindWordBounds(currLP, first, last); 
[F first <= SELF. anchorBegin THEN 
currLP := first 
ELSE 
currLP := last 
END; 


1F currLP <= SELF. anchorBegin THEN 
BEGIN 
oldLP := SELF.textRange.firstLP 
IF SELF.anchorEnd <> SELF. textRange.|astLP THEN 
HiExtOnPads(hOnToOff, SELF. anchorEnd, SELF. textRange.|astLP); 
SELF.textRange.firstLP := currLP 
SELF.textRange.|astLP := SELF. anchorEnd 
END 
ELSE 
BEGIN 
oldLP := SELF. textRange.lastLP; 
IF SELF.anchorBegin <> SELF.textRange.firstLP THEN 
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HiExtOnPads(hOnToOff, SELF.textRange.firstLP, SELF. anchorBegin); 
SELF. textRange.firstLP := SELF. anchor Begin; 
SELF.textRange.|astLP := currLP 
END; 


IF currLP <> oldLP THEN 
IF currLP < ol dLP THEN 
HiExtOnPads(hOffToOn, currLP, ol dLP) 
ELSE 
HiExtOnPads(hOffToOn, ol dLP, currLP); 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxt Hot} 
PROCEDURE TOneParaSel ection. MousePress(mouseLPt: LPoint); 
VAR first, last: INTEGER 
oneParaSel ection: TOneParaSel ection: 
multi ParaSelection: TMultiParaSel ection; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF clickState.fShift THEN 
SELF. MouseMove( mouseLPt) 
ELSE IF clickState.clickCount = 2 THEN {double click} 
BEGIN 
{should select words at beginning and end of current selection (later) } 
SELF. textRange.firstPara. Fi ndWordBounds(SELF.anchorBegin, first, last); 
SELF.textl mage. text. HiliteRange(hOnToOff, SELF.textRange, SELF.isParaSel ection) 
WITH SELF, textRange DO 
{$H- } 
oneParaSelection := TOneParaSel ecti on( SELF. FreedAndRepl acedBy( 
TOneParaSel ection. CREATE(NIL, SELF. Heap 
view, textIl mage, anchorLPt, 
firstPara, firstIlndex, first, last))); 
{$H+} 
WITH oneParaSel ection DO 
BEGIN 
anchorBegin := first; 
anchorEnd := last; 
isWordSelection := TRUE; 
END; 
oneParaSelection.textl mage.text.HiliteRange(hOnToOff, oneParaSel ection. textRange 
SELF.isParaSel ection); 
END 
ELSE IF clickState.clickCount = 3 THEN {triple click} 
BEGIN 
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002108 {Turn current highlighting off first} 

002109 SELF.textl mage. text. HiliteRange(hOnToOff, SELF.textRange, SELF.isParaSel ection) 
002110 WITH SELF, textRange DO 

002111 {$H- } 

002112 oneParaSelection := TOneParaSel ecti on( SELF. FreedAndRepl acedBy( 
002113 TOneParaSel ection. CREATE(NIL, SELF. Heap, 
002114 view, textl mage, anchorLPt, 

002115 firstPara, firstIndex, 0, firstPara.size))); 
002116 {$H+} 

002117 WITH oneParaSelection DO 

002118 BEGIN 

002119 isParaSelection := TRUE; 

002120 isWordSelection := FALSE; 

002121 anchorBegin := 0; 

002122 anchorEnd := textRange.lastLP 

002123 END; 

002124 oneParaSelection.textl mage. text. HiliteRange(hOnToOff, oneParaSelection.textRange, TRUE) 
002125 END 

002126 ELSE 

002127 SELF. textl mage. MousePress( mouseLPt) 

002128 {$I1FC fTrace}EP; {$ENDC} 

002129 END; 

002130 

002131 

002132 {$8 SgTxtHot} 

002133 PROCEDURE TOneParaSel ection. MouseRel ease 

002134 VAR insPt: TinsertionPoint; 

002135 BEGIN 

002136 {$IFC fTrace}BP(10); {$ENDC} 

002137 [F SELF.textRange.firstLP = SELF.textRange.lastLP THEN 

002138 BEGIN 

002139 insPt := SELF. Becomel nserti onPoi nt 

002140 insPt.textl mage.text. HiliteRange(hOffToOn, insPt.textRange, SELF.isParaSel ection); 
002141 END 

002142 ELSE 

002143 SELF. textl mage. text. ChangeSel | nOt her Panel s( SELF) 

002144 SUPERSELF. MouseRel ease 

002145 {$I1FC fTrace}EP; {$ENDC} 

002146 END; 

002147 

002148 

002149 {$8 SgTxtCld} 

002150 FUNCTION TOneParaSel ection. SelSize: INTEGER 

002151 BEGIN 

002152 {$1 FC fTrace}BP(9); {$ENDC} 

002153 SelSize := SELF.textRange.lastLP - SELF.textRange.firstLP 

002154 {$I1FC fTrace}EP; {$ENDC} 

002155 END; 
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002156 
002157 
002158 
002159 
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002161 
002162 
002163 
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002186 
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{$$ SgTxt Hot} 

PROCEDURE TOneParaSel ection. Styl eFromContext; 

VAR typeStyle: TTypeStyle; 

BEGIN 
{$1FC fTrace}BP( 8); {$ENDC} 
SELF. textRange.firstPara. StyleAt(SELF.textRange.firstLP, typeStyle); 
SELF. currTypeStyle := typeStyle; 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ SgTxtI ni} 
END; {Methods of TOneParaSel ecti on} 


METHODS OF TMul ti ParaSel ection; 


{$S SgTxtCld} 
FUNCTION TMul ti ParaSel ection. CREATE(object: TObject; heap: THeap; itsView: TView 
itsTextl mage: TTextl mage; itsAnchorLPt: LPoint; 
beginPara: TEditPara; beginlndex: LONGINT; beginLP: INTEGER 
endPara: TEditPara; endl ndex: LONGINT: endLP: INTEGER: 
beginlsAnchor: BOOLEAN): TMulti ParaSel ection; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TMultiParaSelection(TTextSelection, CREATE(object, heap, itsView, itsTextl mage, itsAnchorLPt, 
beginPara, beginindex, beginLP 
endPara, endindex, endLP)) 


WITH SELF DO 
BEGIN 
1F beginlsAnchor THEN 
BEGIN 
anchorPara := beginPara; 
anchoril ndex := begi ni ndex; 
anchorBegin := beginLP 


anchorEnd := beginLP 
END 

ELSE 
BEGIN 
anchorPara := endPara; 
anchorl ndex := endl ndex: 
anchorBegin := endLP 
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anchorEnd := endLP; 
END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
{$I FC fTextTrace} 
PROCEDURE TMul ti ParaSel ection. Fields( PROCEDURE Field(nameAndType: $255)) 
BEGIN 
TTextSelection. Fields( Field); 
Field('anchorPara: TEditPara'); 
Field(' anchor! ndex: LONGINT'); 
Field('anchorBegin: I NTEGER'); 
Field('anchorEnd: | NTEGER'); 
Field(''); 
END; 
{$ENDC} 


{$S SgTxtCld} 
PROCEDURE TMul ti ParaSelection. ChangeStyle(cmdNumber: TCmdNumber) 
VAR newTypeStyle: TTypeStyle 


S! TListScanner; 

paragraph: TEdit Para; 

last Para: TEdit Para; 

endRng: INTEGER; 

paral mage: TParal mage 
EGIN 


{$1FC fTrace}BP( 10); {$ENDC} 
newlypeStyle := SELF.currTypesStyle; 
lastPara := SELF, textRange.|astPara; 
s := SELF. textl mage.text. paragraphs. ScannerFrom( SELF.textRange.firstIlndex-1, scanForward) 
WHILE s.Scan(paragraph) DO 
[F paragraph = SELF. textRange.firstPara THEN 
BEGIN 
SELF. DoChangeStyle(cmdNumber, paragraph, SELF.textRange.firstLP 
paragraph.size, newTypeStyle); 
SELF.currTypeStyle := newTypeStyle 
IF paragraph = lastPara THEN 
s. Done; 
END 
ELSE 
BEGIN 
IF paragraph = lastPara THEN 
BEGIN 
endRng := SELF. textRange.lastLP 
s. Done; 
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END 
ELSE 
endRng := paragraph.size 


SELF. DoChangeStyle(cmdNumber, paragraph, 0, endRng 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$S SgTxtCld} 
{CopySelf is used for copying to the clipboard} 


FUNCTION TMul ti ParaSelection. CopySelf(heap: THeap; view: TView) 


newlypeStyle); 


TMul ti ParaSel ection; 


VAR srcPara: TEdit Para; 
cpyPara: TEdit Para; 
cpyFirstPara: TEdit Para; 
srcLast Para: TEdit Para; 
cpyLast Para: TEdit Para; 
sel Sizel: | NTEGER; 
selSize2: | NTEGER; 
textl mage: TTextl mage; 
S! TListScanner; 
text: TText; 
text Range: TText Range; 
imageLRect: LRect; 

BEGIN 


{$I FC fTrace}BP( 11); {$ENDC} 


text := TText.CREATE(NIL, heap, TStyleSheet.CREATE(NIL, heap)) 

imageLRect := view. extentLRect; 

InsetLRect(imageLRect, cHorizMargin, cVertMargin); 

textl mage := SELF.textl mage. TxtI mgForClipBoard(heap, view, imageLRect, text, TRUE) 


textl mage. mi nHei ght := 0; 
text. txtl mgList. I nsLast(textl mage); 


textRange := SELF. textRange 

srcPara := textRange.firstPara; 

selSizel := srcPara.size-textRange.firstLP 

cpyPara := textl mage. NewEditPara(selSizel, TParaFormat(srcPara.format.clone(heap))); 


cpyPara. Repl Para(0, 
cpyFirstPara := 


0, srcPara, textRange.firstLP, selSizel); 


cpyPara; 
textl mage. text. paragraphs. I nsLast(cpyFirstPara); 


IF textRange.firstPara <> textRange.lastPara THEN 


BEGIN 
srcLastPara := textRange.|last Para; 
selSize2 := textRange.lastLP; 


cpyLastPara := text! mage. NewEdit Para(sel Size2, 
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cpyLast Para. Rep] Para(0, 0, srcLastPara, 0, selSize2); 


{skip first paragraph by not subtracting one from firstI ndex} 
s := SELF. textl mage. text. paragraphs. ScannerFrom(textRange.firstIl ndex, scanForward) 
WHILE s.Scan(srcPara) DO 
BEGIN 
IF srcPara = textRange.lastPara THEN 
BEGIN 
cpyPara := cpyLast Para; 
s. Done; 
END 
ELSE 
BEGIN 
cpyPara := textl mage. NewEditPara(srcPara. size 
TParaFormat(srcPara.format.clone(heap))); 
cpyPara. Repl Para(0, 0, srcPara, 0, srcPara.size); 


textl mage. text. paragraphs. I nsLast(cpyPara); 
END; 
END; 


textl mage. Recomputel mages(actionNone, TRUE); 
WITH textl mage.extentLRect DO 
view. extentLRect. bottom := bottom- top + 2 * cVertMargin; 


CopySelf := TMultiParaSelection, CREATE(NIL, heap, view, textl mage, zeroLPt, 
TEditPara(textl mage.text. paragraphs. First), 1, 0, 
TEditPara(textl mage.text. paragraphs. Last), 
textRange.|astIndex - textRange.firstIlndex + 1, 
sel Size2, TRUE); 

{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ SgTxtCld} 
FUNCTION TMultiParaSelection. Delete(savelt: BOOLEAN): TText 


VAR firstPara: TEdit Para; 
last Para: TEdit Para; 
paragraph: TEdit Para; 
text: TText; 
paraList: TList; 

S: TListScanner; 
selSize: INTEGER; 

text Range: TText Range; 
numParas: INTEGER; 


PROCEDURE Del Text; 
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BEGIN 
{$1 FC fTrace}BP(11); {$ENDC} 
{If savelt is TRUE, we want to save the text we're deleting, so create a text object} 
IF savelt THEN 


BEGIN 
text := TText. CREATE(NIL, SELF.Heap, NIL); 
paraList := text. paragraphs 
END 
ELSE 
text := NIL; 
textRange := SELF. textRange 
firstPara := textRange.firstPara; 
lastPara := textRange. last Para; 
numParas := SELF.textl mage. text. paragraphs. size 


{lf the last paragraph is selected, treat this like a non-para selection, so that one 
empty para will be left at the end after the delete} 
IF textRange.|astIindex = numParas THEN 

SELF.isParaSelection := FALSE; 


s := SELF. textl mage.text. paragraphs. ScannerFrom(textRange.firstIlndex-1, scanForward) 
WHILE s.Scan(paragraph) DO 
IF paragraph = firstPara THEN 
BEGIN 
[F SELF.isParaSelection THEN 
{If isParaSelection is TRUE then insert it in our save list and 
delete it fromthe textl mage's list} 
BEGIN 
IF savelt THEN 
paraList. I nsLast(firstPara); 
SELF.textl mage. text. Del Para(firstPara, FALSE); 
s.Delete(NOT savelt); 
END 
ELSE 
{lf the beginning of the selection is part of a paragraph, then save 
the characters in a new paragraph and delete themin the old} 
BEGIN 
selSize := firstPara.size - textRange.firstLP; 
IF savelt THEN 
BEGIN 
paragraph := SELF. text! mage. NewEditPara(selSize, firstPara. format) 
paragraph. Repl Para(0, 0, firstPara, textRange.firstLP, sel Size) 
paraList.InsLast(paragraph); 
END; 
firstPara. Repl PString(textRange.firstLP, selSize, NIL) 
END; 
IF firstPara = lastPara THEN 
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s. Done 
END 
ELSE 
BEGIN 
s. Del ete( FALSE); 
|F paragraph = lastPara THEN 
BEGIN 
s. Done; 
1F NOT SELF.isParaSel ection THEN 
{If the end of the selection is a part of a paragraph, then save the 
selected characters in a new paragraph and append the rest to the 
first paragraph. Finally, delete and free the last paragraph } 
BEGIN 
selSize := textRange.|astLP 
IF savelt THEN 
BEGIN 
paragraph := SELF. textl mage. NewEditPara(selSize, |astPara. format); 
paragraph. Repl Para(0, 0, lastPara, 0, selSize); 
END; 
firstPara. Repl Para(firstPara.size, 0, lastPara, selSize 
lastPara.size-sel Size); 
SELF.textl mage. text. Del Para(lastPara, TRUE) 
END 
ELSE 
SELF.textl mage. text. Del Para(paragraph, NOT savelt); 
END 
ELSE 
{Delete entire intermediate paragraphs fromthe textl mage} 
SELF.textl mage. text. Del Para(paragraph, NOT savelt); 
IF savelt THEN 
paraList.InsLast( paragraph); 
END; 
{$1 FC fTrace}EP; {$ENDC} 
END; {Del Text} 


PROCEDURE Set Range; 
BEGIN 
WITH SELF, textRange DO 
IF isParaSelection THEN 

BEGIN 
{$H- } 
firstPara := TEditPara(textl mage. text. paragraphs. At(firstlndex)); 
{$H+} 
firstLP := 0; 
END; 


WITH SELF.textRange DO 
BEGIN 
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lastPara := firstPara: 
lastI ndex := firstindex; 
lastLP := firstLP; 
END; 
END; 
BEGIN 


{$I FC fTrace}BP(11); {$ENDC} 
SELF. ChangeText(Del Text, SetRange); 
Delete := text; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 

PROCEDURE TMul ti ParaSel ection. Del et eAndFree 
VAR text: TText; {dummy var since Delete returns TText; will always be NIL} 
BEGIN 

{$1FC fTrace}BP(11); {$ENDC} 

text := SELF. Del ete(FALSE); 

{$I1FC fTrace}EP; {$ENDC} 
END; 


SgTxt Cl d} 

FUNCTION TMul ti ParaSel ection. Del eteBut Save: 

BEGIN 
{$I FC fTrace}BP( 11); {$ENDC} 
DeleteButSave := SELF. Delete( TRUE); 
{$IFC fTrace}EP; {$ENDC} 

END; 


TText; 


SgTxt Cl d} 
PROCEDURE TMulti ParaSel ection. MouseMove( mouseLPt 
{ assumes highlighting is ON } 


LPoint); 


VAR endPara: TEdi t Para; 
curr Para: TEdi t Para; 
currPl mage: TParal mage; 
ol dPI mage: TParal mage; 
ol dPara: TEdit Para; 
paragraph: TEdi t Para; 
textrange: TText Range; 
textl mage: TTextl mage; 
firstTxtl mg: TTextl mage; 
S! TListScanner; 
paral mage: TParal mage; 
newText: TText; 
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currLP: 
ol dLP: 


mouseBeforeAnchor: 


ol dBeforeCurr: 
begi nl sAnchor: 
currl ndex: 

ol di ndex: 
startlI ndex: 
endl ndex: 
startLP: 
endLP: 

first, last: 
sel Changed: 
{$IFC fTextTrace} 
stri: 

str2: 

{$ENDC} 
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| NTEGER; 
| NTEGER; 
BOOLEAN; 
BOOLEAN; 
BOOLEAN; 
LONGI NT; 
LONGI NT; 
LONGI NT; 
LONGI NT; 
INTEGER; 
INTEGER; 
INTEGER; 
BOOLEAN; 


{ end (ie. not the anchor) of indication } 
{ is mouse LPt before the anchor LPt } 
{ is old end LPt before curr LPt } 


STR255; 
STR255; 


PROCEDURE NextI ndex(oldindex: LONGINT; ol dLP: INTEGER; VAR newlndex: LONGINT; VAR newLP: INTEGER) 


BEGIN 


IF oldindex < SELF.text!l mage. text. paragraphs.size THEN 


BEGIN 


newlndex : 


newLP := 
END 

ELSE 
BEGIN 


newlndex : 
ol dLP; 


newLP := 
END; 
END; 


oldindex + 1; 


ol di ndex; 


PROCEDURE Previndex(oldindex: LONGINT; ol dLP: INTEGER; VAR newlndex: LONGINT; VAR newLP: INTEGER) 


BEGIN 


IF oldindex > 1 THEN 


BEGIN 


newlndex : 


oldindex - 1: 


newLP := TEditPara(SELF.textl mage.text. paragraphs. At(newl ndex)).size; 


END 
ELSE 
BEGIN 


newlndex : 
ol dLP: 


newLP := 
END; 
END; 


ol di ndex; 


PROCEDURE Hi Ext OnPads(highTransit: THighTransit; 
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endindex: LONGI NT; endLP: INTEGER); 
BEGIN 
SELF. textl mage. text. HiliteParagraphs(highTransit, startIlndex, startLP, endilndex, endLP, 
SELF.isParaSel ection); 
END; 


BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF.currLPt := mouseLPt; 


{$1FC fTextTrace} 
1F fTextTrace THEN 
BEGIN 
LI nt ToHex(ORD(SELF.textRange.firstPara), @str1) 
LI nt ToHex(ORD(SELF.textRange.|astPara), @str2); 
Writeln; 
Writeln('*** MultiPara MouseMove: firstPara, lastPara = (', stri, ',', str2, ')'); 
Writeln('*** About to call FindParaAndLp' ); 
END; 
{$ENDC} 


textRange := SELF. textRange 

textl mage := SELF. textl mage. FindTextl mage(mouseLPt, firstTxt! mg) 
SELF.textl mage := firstTxtl mg 

textl mage. FindParaAndLp(mouseLPt, currPl mage, currlndex, currLP) 
currPara := currPl mage. paragraph; 


IF SELF.isParaSelection THEN 


BEGIN 

IF currindex < SELF. anchorI ndex THEN 
currLP := 0 

ELSE 
currLP := currPara.size 

END 

ELSE IF SELF.isWordSelection THEN 
BEGIN 


currPara. FindWordBounds(currLP, first, last); 

IF currindex < SELF. anchor! ndex THEN 
currLP := first 

ELSE IF currlndex > SELF. anchorl ndex THEN 
currLP := last 

ELSE IF first <= SELF.anchorBegin THEN 
currLP := first 

ELSE 
currLP := last; 

END; 


IF currindex = SELF. anchorl ndex THEN 
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mouseBeforeAnchor := currLP < SELF. anchorBegin 
ELSE 
mouseBeforeAnchor := currlndex < SELF. anchorl ndex; 


beginlsAnchor := (textRange.firstIl ndex = SELF.anchor| ndex) AND (textRange.firstLP = SELF. anchor Begin) 


{After determining if the mouse is before or after the anchor position, set up variables for 
higlighting below and dehilite any text that was on other side of the anchor previous to this 
mouse move} 

IF mouseBeforeAnchor THEN 

BEGIN 
oldindex := textRange.firstIndex; 
oldLP := textRange.firstLP 
1F beginlsAnchor THEN 
{current Position is on other side of anchor, so must dehi ghli ght} 
BEGIN 
IF SELF.isParaSelection THEN 
[F SELF.anchorindex = textRange.|astindex THEN 
startindex := -1 
ELSE 
NextI ndex(SELF. anchorIndex, SELF.anchorEnd, startIndex, startLP) 
ELSE 
BEGIN 
startIl ndex := SELF. anchorlndex; 
startLP := SELF. anchorEnd 
END; 
IF startlndex > 0 THEN 
HiExtOnPads(hOnToOff, startindex, startLP, textRange.lastIlndex, textRange.|astLP); 


END; 

WITH SELF, textRange DO 
BEGIN 
firstPara := currPara; 
firstindex := currlndex; 
lastPara := anchorPara; 
lastI ndex := anchorl ndex; 


firstLP := currLP; 
lastLP := anchorEnd 
END; 
END 
ELSE 
BEGIN 
oldindex := textRange.| ast! ndex; 
oldLp := textRange.lastLP 
1F NOT beginlsAnchor THEN 
BEGIN 
{current Position is on other side of anchor, so must dehighli ght} 
1F SELF.isParaSelection THEN 
Previndex(SELF.anchorilndex, SELF.anchorBegin, startIlndex, startLP) 
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002636 ELSE 

002637 BEGIN 

002638 startl ndex := SELF. anchorl ndex; 
002639 startLP := SELF. anchor Begin; 
002640 END: 

002641 Hi Ext OnPads(hOnToOff, textRange.firstindex, textRange.firstLP, startIndex, startLP); 
002642 END; 

002643 WITH SELF, textRange DO 

002644 BEGIN 

002645 lastPara := currPara: 

002646 lastI ndex := currlndex; 

002647 firstPara := anchorPara; 

002648 firstlndex := anchorl ndex; 

002649 firstLP := anchorBegin; 

002650 lastLP := currLP; 

002651 END; 

002652 END; 

002653 

002654 IF mouseBeforeAnchor = beginlsAnchor THEN 
002655 ol dBeforeCurr := NOT mouseBeforeAnchor 
002656 ELSE IF currlndex = oldindex THEN 

002657 oldBeforeCurr := oldLP < currLP 
002658 ELSE 

002659 oldBeforeCurr := oldindex < currlndex: 
002660 

002661 IF ol dBeforeCurr THEN 

002662 BEGIN 

002663 startIl ndex := oldindex; 

002664 startLP := ol dLP: 

002665 endindex := currlndex; 

002666 endLP := currLP; 

002667 END 

002668 ELSE 

002669 BEGIN 

002670 startIl ndex := currlndex; 

002671 startLP := currLP; 

002672 endindex := oldindex; 

002673 endLP := oldLP; 

002674 END; 

002675 

002676 sel Changed := TRUE; 

002677 IF SELF.isParaSelection THEN 

002678 IF startindex = endindex THEN 

002679 sel Changed := FALSE 

002680 ELSE IF mouseBeforeAnchor THEN 

002681 Previndex(endindex, endLP, endindex, endLP) 
002682 ELSE 

002683 NextI ndex(startIl ndex, startLP, startIl ndex, startLP) 
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ELSE 
selChanged := (startIndex <> endindex) OR (startLP <> endLP); 


1F sel Changed THEN 
Hi ExtOnPads(hOffToOn, startindex, startLP, endIlndex, endLP) 


{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
PROCEDURE TMul ti ParaSel ection. MousePress(mouseLPt: LPoint); 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
IF clickState.fShift THEN 
SELF. MouseMove( mouseLPt) 
ELSE IF clickState.clickCount > 1 THEN 
BEGIN 
{For now do nothing if some jerk starts double/triple clicking while dragging} 
END 
ELSE 
SELF. textl mage. MousePress(mouseLPt); 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtCld} 
PROCEDURE TMul ti ParaSel ection. MouseRel ease 
VAR insPt: Tl nsertionPoi nt; 
oneParaSel: TOneParaSel ection; 
first, last: INTEGER; 
isPara: BOOLEAN; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
[F SELF.textRange.firstPara = SELF.textRange.lastPara THEN 
BEGIN 
isPara := SELF.isParaSel ection; 
[F SELF. textRange.firstLP = SELF.textRange.|astLP THEN 
BEGIN 
insPt := SELF. Becomel nserti onPoint; 
insPt.isParaSelection := isPara; 
1F NOT isPara THEN 
insPt.textl mage. text. HiliteRange(hOffToOn, insPt.textRange, FALSE) 
END 
ELSE 
BEGIN 
first := SELF. anchor Begin; 
last := SELF. anchorEnd 
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002732 WITH SELF, textRange DO 

002733 {$H- } 

002734 oneParaSel := TOneParaSel ecti on( SELF. FreedAndRepl acedBy( TOneParaSel ection. CREATE( NIL, 
002735 SELF.Heap, view, textl mage, anchorLPoint, 
002736 firstPara, firstIndex, firstLP, lastLP))); 
002737 {$H+} 

002738 WITH oneParaSel DO 

002739 BEGIN 

002740 anchorBegin := first 

002741 anchorEnd := last; 

002742 isParaSelection := isPara: 

002743 isWordSelection := NOT isPara AND (first <> last); 
002744 END; 

002745 SELF. text! mage. text. ChangeSel | nOtherPanels(oneParaSel ) 
002746 END; 

002747 END 

002748 ELSE 

002749 SELF. textl mage. text. ChangeSel | nOt her Panel s( SELF) 

002750 SUPERSELF. MouseRel ease 

002751 {$I1FC fTrace}EP; {$ENDC} 

002752 END; 

002753 

002754 

002755 {$8 SgTxtCld} 

002756 FUNCTION TMultiParaSelection. Sel Size: INTEGER 

002757 VAR size: INTEGER 

002758 S! TListScanner 

002759 paragraph: TEditPara 

002760 BEGIN 

002761 {$1FC fTrace}BP(9); {$ENDC} 

002762 IF SELF.textRange.firstPara = SELF.textRange.lastPara THEN 

002763 size := SELF.textRange.lastLP - SELF.textRange.firstLP 

002764 ELSE 

002765 BEGIN 

002766 size := SELF.textRange.firstPara.size - SELF.textRange.firstLP 
002767 {skip first paragraph by not subtracting one from firstI ndex} 
002768 s := SELF. textl mage.text. paragraphs. ScannerFrom( SELF. textRange.firstindex, scanForward); 
002769 WHILE s.Scan(paragraph) DO 

002770 IF paragraph = SELF. textRange.|astPara THEN 

002771 BEGIN 

002772 size := size + SELF.textRange.lastLP 

002773 s. Done 

002774 END 

002775 ELSE 

002776 size := size + paragraph. size 

002777 END; 

002778 SelSize := size 

002779 {$I1FC fTrace}EP; {$ENDC} 
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END; 


{$S SgTxtCld} 

PROCEDURE TMul ti ParaSel ection. Styl eFromContext; 

VAR typeStyle: TTypeStyle; 

BEGIN 
{$1FC fTrace}BP( 8); {$ENDC} 
SELF. textRange.firstPara. Styl eAt(SELF.textRange.firstLP, typeStyle); 
SELF. currTypeStyle := typeStyle; 
{$I1FC fTrace}EP; {$ENDC} 

END; 


{$$ SgTxtI ni} 
END; {Methods of TMul ti ParaSel ection} 


{$$ SgTxtCld} 
METHODS OF TClearTextCmd; 


FUNCTION TClearTextCmd. CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
itslmage: Tlmage; itsText: TText): TClearTextCmd 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TClearTextCmd(TCommand. CREATE(object, heap, itsCmdNumber, itsl mage, TRUE, reveal All)); 


WITH SELF DO 
BEGIN 
savedText := NIL: 
text := itsText; 
END; 


{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TClearTextCmd. Free 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
1F SELF.savedText <> NIL THEN 
SELF. savedText. FreeSel f (FALSE); 
SUPERSELF. Free: 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$1 FC fTextTrace} 
PROCEDURE TClearTextCmd. Fields( PROCEDURE Field(nameAndType: $255)) 
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BEGIN 
SUPERSELF. Fields( Field); 
Field('savedText: TText'); 
Field('text: TText'); 
Field(''); 
END; 
{$ENDC} 


PROCEDURE TClearTextCmd. Comnit; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
Free( SELF. savedText); 
SELF.savedText := NIL; 
{$1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TClearTextCmd. Perform cmdPhase: TCmdPhase) 


var textSel: TTextSel ection; 
insertionPt: Tl nsertionPoint; 
text: TText; 
selection: TSelecti on; 
panel: TPanel; 
{$IFC fTextTrace} 
junk: TObj ect; 
strl: STR255; 
str2: STR255; 
{$ENDC} 

BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
panel := SELF.i mage. view. panel 


text := SELF. text; 
CASE cmdPhase OF 
doPhase, redoPhase 
BEGIN 
selection := panel.selecti on; 
WHILE selection. coSelection <> NIL DO 
selection := selection. coSelection: 


{$I FC fTextTrace} 
IF fTextTrace THEN 
BEGIN 
Li nt ToHex(ORD(selection), @str1); 


Writeln('*** Clear Cmd Perfrom; panel last coselection = 


', strl); 


junk := SELF.text. paragraphs. First; {So can set break point here} 


END; 
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002876 {$ENDC} 

002877 

002878 textSel := TTextSelection(selection. FreedAndRepl acedBy( 
002879 text. SelectAll! (TTextSelection(selection).textl mage) ) ) 
002880 text. ChangeSel | nOther Panel s(textSel ); 

002881 text. HiliteRange(hOffToOn, textSel.textRange, FALSE) 

002882 text := textSel.DeleteButSave 

002883 SELF.savedText := text; 

002884 insertionPt := textSel.BecomelnsertionPoint; 

002885 {$I FC fTextTrace} 

002886 IF fTextTrace THEN 

002887 BEGIN 

002888 Li nt ToHex(ORD(insertionPt), @str1) 

002889 Writeln('*** Clear Cmd Perfrom final insertionPt = ', str1) 
002890 junk := SELF.text. paragraphs. First; {So can set break point here} 
002891 END; 

002892 {$ENDC} 

002893 

002894 END; 

002895 undoPhase 

002896 BEGIN 

002897 selection := panel.sel ection; 

002898 WHILE selection. coSelection <> NIL DO 

002899 selection := selection. coSelection:; 

002900 

002901 insertionPt := Tl nserti onPoint(sel ection); 

002902 insertionPt, | nsertText(SELF.savedText, FALSE, FALSE, FALSE); 
002903 Free( SELF. savedText); 

002904 SELF.savedtext := NIL: 

002905 {$$ Need to hilte before, after?} 

002906 SELF. text. ChangeSel | nOther Panel s(inserti onPt) 

002907 END; 

002908 END; 

002909 {$I1FC fTrace}EP; {$ENDC} 

002910 END; 

002911 


002912 {$8 SgTxtI ni} 
002913 END; {METHODS OF TCl earText Cmd} 
002914 {$8 SgTxtCld} 


002915 

002916 

002917 METHODS OF TStyl eCmd; 

002918 

002919 FUNCTION TStyleCmd. CREATE( object: TObject; heap: THeap; itsCmdNumber: TCmdNumber 
002920 itsl mage: Tl mage 

002921 itsFirstI ndex: LONGINT; itsLastIlndex: LONGI NT; 
002922 itsLPFirst: INTEGER; itsLPLast: INTEGER 

002923 itsSelection: TTextSelection): TStyl eCmd; 
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VAR sel: TTextSel ection; 
BEGIN 
{$I1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TStyleCmd(TCommand. CREATE(object, heap, itsCmdNumber 
sel := TTextSelection(itsSel ection. Cl one( SELF. Heap) ); 
WITH SELF DO 
BEGIN 
textSelection := sel 
text := sel. textl mage.text; 
firstFiltParalndex := itsFirstI ndex; 
lastFiltParalndex := itsLastI ndex; 
filtFirstLP := itsLPFirst; 
filtLastLP := itsLPLast; 
currFilteredPara := NIL; 
filteredStyles := NIL; 


END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TStyleCmd. Free 

VAR sPar: TListScanner 
paragraph: TEditPara; 
paral mage: TParal mage 


BEGIN 
{$lFC fTrace}BP( 10); {$ENDC} 


itslmage, TRUE, reveal Some) ); 


sPar := SELF. text. paragraphs. ScannerFrom( SELF. firstFiltParalndex - 1, scanForward) 


WHILE sPar.Scan(paragraph) DO 
BEGIN 
paragraph. beingFiltered := FALSE; 
[F sPar. position = SELF.lastFiltParalndex THEN 
sPar. Done; 
END; 
SELF. textSel ection. Free 
Free(SELF.filteredStyles); 
SUPERSELF. Free: 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$1 FC fTextTrace} 
PROCEDURE TStyleCmd. Fields( PROCEDURE Field(nameAndType: $255)); 
BEGIN 
SUPERSELF. Fields( Field); 
Field('text: TText'); 
Field('textSelection: TTextSelection'); 
Field('firstFiltParalndex: LONGINT') 
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Field('lastFiltParalndex: LONGI NT' ) 
Field('filtFirstLP: I NTEGER'); 
Field('filtLastLP: INTEGER’) 
Field('currFilteredPara: TEditPara'); 
Field('filteredStyles: TArray'); 
Field(''); 
END; 
{$ENDC} 


PROCEDURE TStyl eCmd. Commit; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
SELF. textSel ection. ChangeStyl e( SELF. cmdNumber ) 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TStyleCmd. FilterAndDo( actual Obj ect: TObject 
PROCEDURE DoToObject(filteredObject: TObject)); 


VAR savedStyles: TArray; 
paragraph: TEdit Para; 
typeStyle: TTypeStyle 
firstLP: INTEGER; 
lastLP: INTEGER; 

BEGIN 


{$1FC fTrace}BP( 10); {$ENDC} 
paragraph := TParal mage(actual Obj ect). paragraph; 
[F paragraph. beingFiltered THEN 
BEGIN 
IF paragraph = SELF.currFilteredPara THEN 
BEGIN 
savedStyles := paragraph. typeStyles 
paragraph. typeStyles := SELF. filteredStyles 
END 


ELSE 
BEGIN 
[F paragraph = TEditPara(SELF.text. paragraphs. At(SELF.firstFiltParalndex)) THEN 
firstLP := SELF. filtFirstLP 
ELSE 
firstLP := 0; 


|F paragraph 
lastLP := SELF. filtLastLP 

ELSE 
lastLP := paragraph.size 

Free(SELF.filteredStyles); 

savedStyles := TArray( paragraph. typeStyles. Cl one( SELF. heap)); 


SELF.textSelection. DoChangeStyle(SELF.cmdNumber, paragraph, firstLP, lastLP, typeStyle) 
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003020 SELF.currFilteredPara := paragraph; 

003021 SELF.filteredStyles := paragraph. typeStyles 
003022 END; 

003023 

003024 DoToObj ect(TParal mage(actual Obj ect)); 

003025 

003026 paragraph.typeStyles := savedStyles 

003027 END 

003028 ELSE 

003029 DoToObj ect(TParal mage(actual Obj ect) ); 

003030 {$IFC fTrace}EP; {$ENDC} 

003031 END; 

003032 

003033 

003034 PROCEDURE TStyleCmd. Perform(cmdPhase: TCmdPhase); 

003035 VAR textSelection: TTextSel ection; 

003036 selection: TSelection; 

003037 sPar: TListScanner 

003038 paragraph: TEdit Para; 

003039 

003040 {Need to filter paragraph before asking about its type styles} 
003041 PROCEDURE FindFilteredStyle(obj: TObj ect); 

003042 BEGIN 

003043 textSelection. Styl eFromContext; 

003044 END; 

003045 

003046 BEGIN 

003047 {$1FC fTrace}BP( 10); {$ENDC} 

003048 selection := SELF. image. view. panel. selection; 

003049 WHILE selection. coSelection <> NIL DO 

003050 selection := selection. coSel ection; 

003051 

003052 textSelection := TTextSel ection(sel ection) 

003053 1F cmdPhase = doPhase THEN 

003054 BEGIN 

003055 sPar := SELF. text. paragraphs. ScannerFrom( SELF. firstFiltParalndex - 1, scanForward) 
003056 WHILE sPar.Scan(paragraph) DO 

003057 BEGIN 

003058 paragraph. beingFiltered := TRUE; 

003059 [F sPar. position = SELF.lastFiltParalndex THEN 
003060 sPar. Done; 

003061 END; 

003062 END; 

003063 textSelection, MarkChanged 

003064 textSelection. text! mage. text. Recomputel mages; 

003065 SELF. FilterAndDo( TParal mage( TEditPara(SELF. text. paragraphs. At( 
003066 SELF. firstFiltParalndex)).images. First), FindFilteredStyle); 
003067 (*textSelection. | nvalidate; *) 
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{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtI ni} 
END; {METHODS OF TStyl eCmd} 
{$$ SgTxtCld} 


METHODS OF TTextCutCopy; 


FUNCTION TTextCutCopy. CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; 
itslmage: Tlmage; isCutCmd: BOOLEAN; itsText: TText): TTextCutCopy; 
BEGIN 
{$1FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TTextCutCopy(TCutCopyCommand. CREATE(object, heap, itsCmdNumber, itsIl mage, isCutCmd) ) 
WITH SELF DO 
BEGIN 
text := itsText; 
IF itsCmdNumber = uCopy THEN 
BEGIN 
unHiliteBefore[doPhase] := FALSE; 
hiliteAfter[doPhase] := FALSE; 
END; 


END; 
{$1FC fTrace}EP; {$ENDC} 
END; 


{$I FC fTextTrace} 
PROCEDURE TTextCutCopy. Fields(PROCEDURE Field(nameAndType: $255)); 
BEGIN 
TCut CopyCommand. Fields( Field); 
Field('text: TText'); 
Field(''); 
END; 
{$ENDC} 


PROCEDURE TTextCutCopy. DoCutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN; 
cmdPhase: TCmdPhase); 


VAR textSel: TTextSel ection; 
insertionPt: Tl nsertionPoint; 
multi ParaSel: TMul ti ParaSel ection: 
heap: THeap; 
firstPara: TEdit Para; 
firstLP: INTEGER; 
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panel: TPanel; 
selection: TSelecti on; 
saveTextSel: TText Selection; 
firstIl ndex: LONGI NT; 

BEGIN 


{$1FC fTrace}BP( 10); {$ENDC} 
heap := SELF. Heap; 
panel := SELF.i mage. vi ew. panel 
CASE cmdPhase OF 
doPhase, redoPhase 
BEGIN 
selection := panel.selecti on; 


{we know that the last coSelection must be the textSelection since textSelections 


do not have coSelections} 
WHILE selection. coSelection <> NIL DO 
selection := selection. coSel ection; 


textSel := TTextSelection(selection); 
IF (cmdPhase = redoPhase) AND deleteOriginal THEN 


SELF.text. HiliteRange(hOffToOn, textSel.textRange, textSel.isParaSel ection); 


textSel.CutCopy(clipSelection, deleteOri ginal); 


END; 
undoPhase: 
BEGIN 
IF deleteOriginal THEN 
BEGIN 
selection := panel.sel ection; 


WHILE selection. coSelection <> NIL DO 
selection := selection. coSelection; 


insertionPt := Tl nsertionPoint(selection); 
firstPara := insertionPt. text Range. firstPara; 
firstLP := insertionPt.textRange.firstLP 
firstIndex := insertionPt. text Range. firstI ndex; 


{get the cut text fromthe clipboard and insert it back into the text} 
mul tiParaSel := TMultiParaSelection(clipSelection); 
insertionPt. I nsertText( multi ParaSel.textl mage.text, multi ParaSel.isParaSel ection, 


1F multi ParaSel.isParaSelection THEN 
BEGIN 
WITH insertionPt DO 
IF textRange.firstlndex > 1 THEN 
BEGIN 


mul tiParaSel.isWordSelection, FALSE); 


textRange.firstIindex := textRange.firstIndex - 1; 


Apple Lisa ToolKit 3.0 Source Code Listing -- 922 of 1012 


003164 
003165 
003166 
003167 
003168 
003169 
003170 
003171 
003172 
003173 
003174 
003175 
003176 
003177 
003178 
003179 
003180 
003181 
003182 
003183 
003184 
003185 
003186 
003187 
003188 
003189 
003190 
003191 
003192 
003193 
003194 
003195 
003196 
003197 
003198 
003199 
003200 
003201 
003202 
003203 
003204 
003205 
003206 
003207 
003208 
003209 
003210 
003211 


Apple Lisa Computer Technical Information 


{$H- } 

textRange.firstPara := TEditPara(SELF. text. paragraphs. At(textRange. firstIndex)); 
textRange.firstLP := textRange.firstPara.size 

{$H+} 

END; 


END 

ELSE IF multi ParaSel.isWordSelection THEN 
{don't want to select extra blank generated by insert} 
WITH insertionPt DO 


{$H- } 
IF firstPara. At(firstLP + 1) = ' ' THEN 
firstLP := firstLP + 1 
ELSE IF textRange.firstPara. At(textRange.firstLP) = ' ' THEN 
textRange.firstLP := textRange.firstLP - 1; 
{$H+} 
{build the original selection} 
textSel := TTextSelection(selection. FreedAndRepl acedBy( 


insertionPt.textl mage. NewText Sel ecti on( 
firstPara, firstIindex, firstLP, insertionPt. textRange.firstPara, 
insertionPt.textRange.firstI ndex, insertionPt,textRange.firstLP))); 
textSel.isParaSelection := multiParaSel.isParaSel ection; 


SELF. text. ChangeSel | nOtherPanel s(textSel ) 
END; 
END; 


END; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtI ni} 
END; {METHODS OF TTextCutCopy} 
{$$ SgTxtCld} 


METHODS OF TTextPaste: 


FUNCTION TTextPaste. CREATE(object: TObject; heap: THeap; itsl mage: Tl mage 
itsText: TText): TTextPaste 
VAR range: TText Range 
BEGIN 
{$I FC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TTextPaste(TPasteCommand. CREATE(object, heap, uPaste, itslmage)); 
{need noSelection since it gets FreedAndRepl acedBy' ed} 
range := TTextRange.CREATE(NIL, heap, NIL, 0, 0, NIL, 0, 0); {Performinitializes} 
WITH SELF DO 
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BEGIN 

pasteRange := range 
text := itsText; 
savedText := NIL: 
origlsPara := FALSE; 
origlsWord := FALSE; 
cliplsPara := FALSE; 
END; 


{$1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TText Paste. Free; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
1F SELF.savedText <> NIL THEN 
SELF. savedText. FreeSel f (FALSE); 
Free( SELF. pasteRange); 
SUPERSELF. Free: 
{$I1FC fTrace}EP; {$ENDC} 
END; 


{$I FC fTextTrace} 
PROCEDURE TText Paste. Fi el ds( PROCEDURE Field( nameAndType 
BEGIN 
SUPERSELF. Fields(Field); 
Field('savedText: TText'); 
Field('pasteRange: TTextRange' ) 
Field('text: TText'); 
Field('origlsPara: BOOLEAN' ) 
Field('origlsWord: BOOLEAN' ) 
Field('cliplsPara: BOOLEAN' ) 
Field(''); 
END; 
{$ENDC} 


$255)); 


PROCEDURE TText Paste. Commit; 
BEGIN 
{$1FC fTrace}BP( 10); {$ENDC} 
Free( SELF. savedText); 
SELF.savedText := NIL; 
{$I1FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE TText Paste. DoPaste(clipSelection: 
VAR heap: THeap; 
textSel: TTextSel ection; 
saveTextSel: TTextSel ection; 
insertionPt: Tl nsertionPoi nt; 


TSelection; pic: 
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insPt Before: 
insPtAfter: 
text: 
firstPara: 
firstLP: 
firsti ndex: 
panel: 
selection: 
BEGIN 
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Tl nserti onPoi nt; 

Tl nserti onPoi nt; 

TText; 

TEditPara; {bad choice of var names; change later (screws up WTH's)} 
INTEGER; 

LONGI NT; 

TPanel 

TSel ection; 


{$1FC fTrace}BP( 10); {$ENDC} 
heap := SELF. Heap; 

panel := SELF.i mage. view. panel 
CASE cmdPhase OF 


doPhase, 
BEGI 
IF | 


redoPhase: 
N 
nClass(clipSelection, TTextSelection) OR (clipBoard. hasUniversal Text) THEN 
BEGIN 
selection := panel.selection; 
{we know that the last coSelection must be the textSelection since textSelections 
do not have coSelections} 
WHILE selection. coSelection <> NIL DO 
selection := selection. coSelecti on: 
textSel := TTextSelection(selection); 
SELF.origlsPara := textSel.isParaSel ection; 
SELF. origlsWord := textSel.isWordSel ection; 
IF InClass(clipSelection, TTextSelection) THEN 
SELF.cliplsPara := TTextSelection(clipSelection).isParaSel ection; 


{delete the selected text, leaving an insertion point} 
text := textSel.DeleteButSave 
SELF.savedText := text; 
insertionPt := textSel.Becomel nserti onPoi nt 
WITH SELF, insertionPt DO 
BEGIN 
pasteRange.firstPara := textRange.firstPara; 
pasteRange. firstindex := textRange.firstl ndex; 
pasteRange.firstLP := textRange.firstLP; 
END; 


insertionPt. FinishPaste(clipSelection, pic); 


WITH SELF, insertionPt DO 
IF cliplsPara THEN 
BEGIN 
{$H- } 
pasteRange.lastIndex := Max(1, textRange.firstindex - 1); 
pasteRange.|astPara := TEditPara(SELF.text. paragraphs. At( pasteRange. | astI ndex)); 
pasteRange.|astLP := pasteRange.|astPara.size 
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{$H+} 
END 

ELSE 
BEGIN 
pasteRange.|astPara := textRange.firstPara; 
pasteRange.lastIndex := textRange. first! ndex; 
pasteRange.|astLP := textRange.firstLP 


END; 
SELF. text. ChangeSell nOtherPanels(insertionPt); 
END 
ELSE 
BEGIN 


panel. selection. CantDolt; 
SELF. undoable := FALSE; 
END; 

END; 

undoPhase: 

BEGIN 

WITH SELF. pasteRange DO 
{$H- } 
textSel := TTextl mage(SELF.image).NewTextSelection(firstPara, firstlndex, firstLP 

lastPara, lastIindex, lastLP); 

{$H+} 

textSel.isParaSelection := SELF.cliplsPara; 


{user feedback: highlight pasted text} 
SELF. text. HiliteRange(hOffToOn, SELF. pasteRange, textSel.isParaSel ection) 


{get rid of pasted text; can get it fromclipboard for redo} 
textSel. Del eteAndFree 


insertionPt := textSel.BecomelnsertionPoint; 
firstPara := insertionPt.textRange. firstPara; 
firstLP := insertionPt.textRange.firstLP 
firstIndex := insertionPt.textRange.firstl ndex; 


{put back any text that was pasted over} 
insertionPt.I nsertText(SELF.savedText, SELF.origlsPara, SELF.origlsWord, FALSE) 


WITH insertionPt DO 
[F SELF.origlsPara THEN 
BEGIN 
{$H- } 
textRange.firstindex := Max(1, textRange.firstIndex - 1); 
textRange.firstPara := TEditPara(SELF.text. paragraphs. At(textRange.firstIndex)); 
textRange.firstLP := textRange.firstPara.size 
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{$H+} 
END; 


Free( SELF. savedText); 
SELF.savedText := NIL: 


selection := panel.selecti on; 
WHILE selection. coSelection <> NIL DO 
selection := selection. coSelection: 


{build original selection (ie before the paste) } 
text Sel 


:= TTextSelection(sel ection, FreedAndRepl acedBy( 


insertionPt. text! mage. NewText Sel ecti on( 


firstPara, firstIndex, 


textSel.isParaSelection := SELF. origlsPara; 
textSel.isWordSelection := SELF. origlsWord; 
SELF. text. ChangeSell nOther Panel s(textSel); 
insertionPt. Free; 

END; 


END; 
{$IFC fTrace}EP; {$ENDC} 
END; 


{$$ SgTxtI ni} 
END; {METHODS OF TTextPaste} 
{$$ SgTxtHot} 


METHODS OF TTypingCmd; 


FUNCTION TTypingCmd. CREATE(object: TObject; heap: THeap; 
itsText: TText): TTypingCmd; 
VAR range: 
BEGIN 
{$IFC fTrace}BP(11); {$ENDC} 
IF object = NIL THEN 
object := NewObject(heap, THISCLASS) 
SELF := TTypingCmd(TCommand. CREATE(object, heap, uTyping 
range := TTextRange.CREATE(NIL, heap, NIL, 0, 0, NIL, 0, 0); 
WITH SELF DO 
BEGIN 
newCharCount : 
newParaCount : 
text := itsText; 
savedText := NIL: 
typingRange := range 
otherlnsPts := NIL; 


TText Range; 


0 
0 
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firstLP, 
insertionPt.text Range. firstI ndex, 


insertionPt.textRange. firstPara, 
insertionPt.textRange.firstLP))) 


itslmage: Tl mage 


itslmage, TRUE, reveal All)); 
{Perform initializes} 
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hiliteAfter[doPhase] := FALSE; 
END; 
{$IFC fTrace}EP; {$ENDC} 


PROCEDURE TTypingCmd. Free 


VAR 
BEGI 


END; 


selection: TSelecti on: 

N 

{$1FC fTrace}BP( 10); {$ENDC} 

Free(SELF.savedText); 

selection := SELF. image. view. panel. selection; 

WHILE selection. coSelection <> NIL DO 
selection := selection. coSelecti on; 


IF InClass(selection, TlnsertionPoint) THEN 
BEGIN 
Til nsertionPoint(selection).typingCmd := NIL; 
Til nsertionPoint(selection).amTyping := FALSE; 
END; 


SELF. typi ngRange. Free 

IF SELF.otherlnsPts <> NIL THEN 
SELF. otherl nsPts. FreeObj ect; 

SUPERSELF. Free: 

{$I1FC fTrace}EP; {$ENDC} 


{$S SgTxtCld} 
{$1 FC fTextTrace} 


PROCEDURE TTypingCmd. Fields( PROCEDURE Field(nameAndType 


BEGI 


END; 
{$ENDC} 


N 

SUPERSELF. Fields( Field); 
Field(''); 

Field('savedText: TText'):; 
Field('text: TText'); 
Field('newCharCount: | NTEGER' ) 
Field('newParaCount: | NTEGER' ) 
Field('typingRange: TTextRange'); 
Field('otherlnsPts: TList'); 
Field(''); 


{$$ SgTxt Hot} 
PROCEDURE TTypingCmd. Perform(cmdPhase: TCmdPhase); 


VAR 


text: TText; 
insertionPt: TI nsertionPoint; 


$255) ); 
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selection: TSelecti on; 
heap: THeap; 
firstPara: TEdit Para; 
firstLP: INTEGER; 
textSel: TTextSel ection; 
panel: TPanel: 

first ndex: LONGI NT; 

aList: TList; 
typeStyle: TTypeStyle 


PROCEDURE InstalllnsPts(obj: TObj ect); 
VAR selection: TSelection; 


BEGIN 


selection := TTextl mage(obj).view. panel.selecti on; 
WHILE selection. coSelection <> NIL DO 


selection := selection. coSel ection; 


IF selection <> insertionPt THEN 


END; 


BEGIN 
{$lFC fTrace}BP( 10); {$ENDC} 


heap : 
panel 


aList.InsLast(selection); 


SELF. Heap; 


:= SELF. image. view. panel 


CASE cmdPhase OF 
doPhase, redoPhase 


BEGIN 

selection := panel.sel ection; 

WHILE selection. coSelection <> NIL DO 
selection := selection. coSelection: 


textSel := TTextSelection(selection); 
typeStyle := textSel.currTypeStyle 


{We don't want to delete the entire paragraph if we're typing over it, 
so set isParaSelection to FALSE} 
textSel.isParaSelection := FALSE; 


(***** Changed following line 4/27/84 13:07 LSR 
BUG: redo of backspace (?) leaves garbage 


KKK) 


deferUpdate := TRUE; 

deferUpdate := (cmdPhase = doPhase) OR (SELF.savedText <> NIL) 
text := textSel. DeleteButSave 

insertionPt := textSel. BecomelnsertionPoint; 


WITH SELF. typingRange DO 
BEGIN 
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firstPara := insertionPt. text Range. first Para; 
firstIndex := insertionPt.textRange. firstl ndex; 
firstLP := insertionPt.textRange.firstLP 


lastPara := firstPara; 

lastindex := firstIndex; 

lastLP := firstLP 

END; 

IF cmdPhase = doPhase THEN 

BEGIN 

WITH insertionPoint DO 
BEGIN 
amTyping := TRUE; 
typingCmd := SELF; 
[F TFakeTStyle(currTypeStyle) <> TFakeTStyle(typeStyle) THEN 


BEGIN 

styleCmdNumber :=-1; {so correct typeStyle will be used} 
currTypeStyle := typeStyle; 

END; 


END; 
{lf there is more than one panel displaying this text, then store the insertion points 
of the other panels in a list for quick access while typing} 
[F SELF.text.txtl mgList.size > 1 THEN 

BEGIN 

aList := TList.CREATE(NIL, heap, 0) 

SELF. text. txtl mglList. Each(InstalllnsPt); 

SELF. otherIlnsPts := aList; 

END; 
insertionPt.textRange.firstPara. StartEdit(insertionPt.textRange. first Para. GrowSi ze); 
END 


ELSE 
BEGIN 
firstPara := insertionPt.textRange. firstPara; 
firstLP := insertionPt.textRange.firstLP 
firstIndex := insertionPt.textRange. firstI ndex; 


{put back the typed text} 

deferUpdate := FALSE; 

insertionPt. | nsertText(SELF.savedText, FALSE, FALSE, FALSE); 
Free(SELF.savedText); 


WITH SELF. typingRange DO 
BEGIN 


lastPara := insertionPt. textRange.firstPara; 
lastindex := insertionPt.text Range. firstl ndex 
lastLP := insertionPt.textRange. firstLP; 

END; 


{build typed selection} 
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003548 
003549 
003550 
003551 
003552 
003553 
003554 
003555 
003556 
003557 
003558 
003559 
003560 
003561 
003562 
003563 
003564 
003565 
003566 
003567 
003568 
003569 
003570 
003571 
003572 
003573 
003574 
003575 
003576 
003577 
003578 
003579 
003580 
003581 
003582 
003583 
003584 
003585 
003586 
003587 
003588 
003589 
003590 
003591 
003592 
003593 
003594 
003595 
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textSel := TTextSelection(insertionPt. FreedAndRepl acedBy( 
insertionPt.textl mage. NewTextSel ecti on( 
firstPara, firstIndex, firstLP, insertionPt.textRange.firstPara, 
insertionPt.textRange.firstindex, insertionPt.textRange.firstLP))); 


SELF. text. ChangeSel | nOther Panel s(textSel ) 
END; 


{We always need a valid savedText object, even if no characters were initially typed 
over, in case previous characters get backspaced over. See code in KeyBack } 
IF text = NIL THEN 
BEGIN 
text := TText.CREATE(NIL, heap, NIL) 
text. paragraphs. I nsLast( 
TText! mage( SELF. image). NewEditPara(0, SELF.typingRange.firstPara. format) ) 


END; 
SELF.savedText := text; 


END; 
undoPhase: 

BEGIN 

WITH SELF. typingRange DO 
{$H- } 
textSel := TTextl mage(SELF.image).NewTextSelection(firstPara, firstlndex, firstLP 

lastPara, lastIlndex, lastLP); 

{$H+} 


{user feedback: highlight typed text} 
SELF. text. HiliteRange(hOffToOn, SELF.typingRange, textSel.isParaSel ection) 


{delete but save typed text} 
text := textSel.DeleteButSave 


insertionPt := textSel.BecomelnsertionPoint; 
firstPara := insertionPt.textRange. firstPara; 
firstLP := insertionPt.textRange.firstLP 
firstIndex := insertionPt.textRange.firstl ndex; 


{put back any text that was typed over} 
insertionPt. | nsertText(SELF.savedText, FALSE, FALSE, FALSE); 


Free( SELF. savedText); 
SELF.savedText := text; 


selection := panel.sel ection; 


WHILE selection. coSelection <> NIL DO 
selection := selection. coSel ection; 
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003596 {build original selection (before typing) } 

003597 textSel := TTextSelection(selection. FreedAndRepl acedBy( 

003598 insertionPt. text! mage. NewText Sel ecti on( 

003599 firstPara, firstIndex, firstLP, insertionPt. textRange.firstPara, 
003600 insertionPt.textRange.firstI ndex, insertionPt,textRange.firstLP))); 
003601 

003602 SELF. text. ChangeSell nOtherPanels(textSel); 

003603 insertionPt. Free: 

003604 END; 

003605 END; 

003606 {$I1FC fTrace}EP; {$ENDC} 

003607 END; 

003608 


003609 {$S SgTxtI ni} 

003610 END; {METHODS OF TTypingCmd} 
003611 {$8 SgTxtCld} 

003612 

003613 


End of File -- Lines: 3613 Characters: 131485 
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FILE: "LIBTK/ UUNI VTEXT. TEXT" 


000001 {$E+} 

000002 {$E ERR1. TEXT} 

QUOUUS. Sheet tipo cerned eter nts eeretetie rarer ete ee tat attra near aeAedimes Maen eae wana aie ware ett tae 
000004 { UUniversal Text V0.3 

(0000S Tieatiamet cima tat amd ea ce tes ae ee eanna ates k ccna en tame dol hate nel pusannmm es cnm eae ccedantemamn me auc ae Naps 
000006 {$SETC For0S := TRUE } 

000007 {$DECL Wit hUObj ect} 


000008 {$SETC WthUObj ect := TRUE} {Note: TRUE/ FALSE status MUST agree with bel ow} 
000009 

000010 

000011 

000012 UNIT {$1 FC WithUObj ect} 

000013 UTKUni versal Text 

000014 {$ELSEC} 

000015 UUni versal Text 

000016 {$ENDC}; 

000017 


000018 {$DECL Isintrinsic} 

000019 {$SETC Isintrinsic := TRUE} 

000020 

000021 {$SETC WthUObj ect := TRUE} {Note: TRUE/ FALSE status MUST agree with above} 
000022 

000023 {$lFC Isintrinsic} 

000024 INTRINSIC; 

000025 {$ENDC} 


000026 

000027 {$l1FC NOT WthUObj ect} 

000028 {$SETC LibraryVersion := 30 } { 10 = 1.0 libraries; 13 = 1.3 libraries; 20 = Pepsi, 30 = Spring, etc. } 
000029 {$ENDC} 

000030 

000031 INTERFACE 

000032 


000033 USES 
000034 {$I1FC WthUObj ect} 


000035 {$U libtk/ UObj ect } UObj ect, 

000036 {$SETC fTrce := fTrace} 

000037 {$ENDC} 

000038 {$U libsm/ UnitStd. obj } Unit Std, 

000039 {$U libsm/UnitHz. obj } Uni t Hz 

000040 {$I1FC NOT WthUObj ect} 

000041 {$U libpl/UClascal } UClascal, {Will be in PASLIB in Spring} 
000042 {$U libqd/ Storage. obj } Storage 


000043 {$ENDC} 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 
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{$1FC LibraryVersion <= 20} 
{$U libfm/FontMgr. obj } Font Mgr 
{$U libqd/ QuickDraw. obj } Qui ckDraw 
{$ELSEC} 
{$U libqd/QuickDraw. obj } Qui ckDraw 
{$U libfm/FontMgr. obj } Font Mgr 
{$ENDC} 
{$U - #BOOT-SysCall } Syscall, 


{$U libpm/ PMDecl. obj } PMDec! 
{$U libpr/PrStdinfo.obj } PrStdinfo 
{$U libsu/UnitFmt. obj } Unit Fmt, 
{$U libsu/UnitCS. obj } Unit CS, 
{$U libwm/ Events. obj } Events, 
{$U libsu/Scrap. obj } Scrap; 


{$DECL f Universal Text Trace} 

{$1 FC NOT WthUObj ect} 
{$DECL f DebugMet hods} 
{$SETC fDebugMethods := FALSE} 
{$DECL fDbgObj ect } 


{$DECL fTrce} 
{$SETC fTrce := FALSE} 


{$SETC fDbgObj ect := FALSE} 
{$ENDC} 
{$SETC f Universal TextTrace := fTrce} 
{$DECL PasteTrace} 
{$SETC PasteTrace := FALSE} 
TYPE 
{$1 FC NOT WthUObj ect} 


$255 = STRING[ 255] 
THeap = Ptr; {alias for THz} 


{Must be FALSE} 


{Must be FALSE} 


{Set to FALSE for final libraries} 


{Nor mal } 


{Generates READLN asking for tracing during Write UT} 


TClass = Ptr; {alias for TPSliceTable in UClascal } 


TCollecHeader = RECORD 


classPtr: TClass 
size: LONGI NT; {number of real elements, not counting the hole} 
dynStart: INTEGER; {bytes fromthe class ptr to the dynamic data; MAXINT if none all owed} 
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000092 holeStart: | NTEGER; {0 = at the beginning, size = at the end; MAXINT = none all owed} 
000093 hol eSi ze: | NTEGER; {measured in MemberBytes units} 

000094 holeStd: | NTEGER; {if the holeSize goes to 0, how much to grow the collection by} 
000095 END; 

000096 

000097 TFastString = RECORD {only access ch[{i] when hole is at end & TString is not subclassed} 
000098 header: TColl ecHeader 

000099 ch: PACKED ARRAY[1..32740] OF CHAR 

000100 END; 

000101 TPFastString = *TFastString 

000102 THFastString = *TPFastString 

000103 

000104 

000105 TUTObj ect = SUBCLASS OF NIL 

000106 

000107 FUNCTION {TUTObj ect. }CREATE(heap: THeap): TUTObject; ABSTRACT; 

000108 FUNCTION {TUTObject.}Heap: THeap; {which heap it is in} 

000109 PROCEDURE {TUTObj ect. }FreeObj ect; DEFAULT; {frees just the object, not its contents} 
000110 PROCEDURE {TUTObj ect. }Free; DEFAULT; {frees the object and its contents} 
000111 FUNCTION {TUTObject.}Class: TClass 

000112 END; 

000113 

000114 TUTCollection = SUBCLASS OF TUTObj ect 

000115 

000116 {Variables} 

000117 size: LONGI NT; {number of real elements, not counting the hole} 

000118 dynStart: | NTEGER; {bytes fromthe class ptr to the dynamic data} 

000119 holeStart: | NTEGER; {0 means hole at the beginning, size means hole at the end} 

000120 hol eSi ze: INTEGER; {measured in MemberBytes units} 

000121 hol eStd: | NTEGER; {if the holeSize goes to 0, how much to grow the collection by} 
000122 

000123 FUNCTION {TCollection. }CREATE( object: TUTObject; heap: THeap; initialSlack: INTEGER): TUTColl ection; 
000124 FUNCTION {TCollection. }AddrMember(i: LONGI NT): LONGI NT 

000125 FUNCTION {TCollection. }MemberBytes: INTEGER; ABSTRACT; 

000126 PROCEDURE {TCollection. }EditAt(atI ndex: LONGINT; deltaMembers: | NTEGER) 

000127 PROCEDURE {TCollection. }I nsManyAt(i: LONGINT; otherCollection: TUTCollection; index, howMany: LONGI NT); 
000128 PROCEDURE {TColl ection. }ResizeColl(membersPlusHole: I NTEGER) 

000129 PROCEDURE {TCollection. }ShiftColl(afterSrclndex, afterDstIlndex, howMany: I NTEGER) 

000130 PROCEDURE {TCollection. }StartEdit(withSlack: INTEGER) 

000131 PROCEDURE {TColl ection. }StopEdit; 

000132 END; 

000133 

000134 TUTArray = SUBCLASS OF TUTCollection 

000135 

000136 recordBytes: INTEGER; 

000137 

000138 FUNCTION {TArray. }}CREATE(object: TUTObject; heap: THeap; initial Slack, bytesPerRecord: I NTEGER) 
000139 : TUTArray; 
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000140 FUNCTION {TArray. }MemberBytes: INTEGER; OVERRI DE; 

000141 FUNCTION {TArray. }At(i: LONGINT): Ptr; DEFAULT; 

000142 PROCEDURE {TArray. }IlnsAt(i: LONGINT; pRecord: Ptr); DEFAULT; 

000143 PROCEDURE {TArray. }IlnsLast(pRecord: Ptr); 

000144 PROCEDURE {TArray. }Del All 

000145 PROCEDURE {TArray. }Del At(i: LONGINT); DEFAULT; 

000146 PROCEDURE {TArray. }Del ManyAt(i, howMany: LONGINT); DEFAULT; 

000147 PROCEDURE {TArray. }PutAt(i: LONGINT; pRecord: Ptr) 

000148 END; 

000149 

000150 

000151 TUTString = SUBCLASS OF TUTColl ection 

000152 

000153 FUNCTION {TString. }CREATE(object: TUTObject; heap: THeap; initial Slack: INTEGER): TUTString 
000154 FUNCTION {TString. }At(i: LONGINT): CHAR 

000155 FUNCTION {TString.}MemberBytes: INTEGER; OVERRI DE; 

000156 PROCEDURE {TString. }ToPAOCAt(i, howMany: LONGINT; pPackedArrayOfCharacter: Ptr); 
000157 PROCEDURE {TString. }l nsAt(i: LONGINT; character: CHAR) 

000158 PROCEDURE {TString. }l nsPAOCAt(i: LONGINT; pPackedArrayOfCharacter: Ptr; howMany: LONGI NT); 
000159 PROCEDURE {TString. }Del At(i: LONGI NT) 

000160 PROCEDURE {TString. }Del ManyAt(i, howMany: LONGI NT) 

000161 PROCEDURE {TString. }Del All; 

000162 END; 

000163 

000164 {$ENDC} 

000165 

000166 TEnumLevel OfGranularity = (UTCharacters, UTParagraphs) 

000167 TLevel OfGranul arity = SET OF TEnumLevel Of Granul arity; 

000168 

000169 TCharDescriptor = RECORD { character descroptor record } 

000170 font: INTEGER; { font number } 

000171 face: {$1FC LibraryVersion <= 20}TSeteface{$ELSEC}styl e{$ENDC}; { formating } 
000172 superscript: -128..127; { number of bits to superscript } 

000173 keepOnSamePage: BOOLEAN 

000174 END; 

000175 

000176 TTabTypes = (qLeftTab, qCenterTab, qRi ght Tab, qPeriodTab, qCommaTab) ; 
000177 TTabFill = (tNoFill, tDot Fill, tHyphenFill, t UnderLineFill) 

000178 TParaTypes = (qLeftPara, qCenterPara, qRi ght Para, qj) ust Para) 

000179 

000180 TTabDescriptor = RECORD 

000181 position: INTEGER; {Location of the tab} 

000182 fill Bet weenTabs: TTabFill; {Fill character for the tab} 

000183 tabType: TTabTypes; {Type of tab} 

000184 END; 

000185 

000186 TParaDescriptor = RECORD 

000187 paragraphStart: BOOLEAN; { TRUE if the beginning of the run is also the beginning of a paragraph} 
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000188 
000189 
000190 
000191 
000192 
000193 
000194 
000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
000210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
000228 
000229 
000230 
000231 
000232 
000233 
000234 
000235 
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{$1 FC WithUObj ect } 


additional Chri nParagraph: INTEGER 
{$ENDC} 
firstLineMargin: INTEGER; {Left margin of first line} 
bodyMar gin: | NTEGER; {Left margin of subsequent lines} 
right Margin: INTEGER; {Right margin} 
paraLeadi ng: | NTEGER; {Paragraph leading} 
lineSpacing: 0.. 63; {I nter-line spacing } 
{$1 FC WithUObj ect } 
tabTable: TArray {OF TTabDescriptor}; { table of tabs 
{$ELSEC} 
tabTable: TUTArray {OF TTabDescriptor}; { table of tabs 
{$ENDC} 
paraType: TParaTypes; {Paragraph adjustment } 
hasPicture: BOOLEAN 
END; 


{$1 FC WithUObj ect } 
TTKUnivText = SUBCLASS OF TOBJ ECT 


{$ELSEC} 
TUnivText = SUBCLASS OF TUTObj ect 
{$ENDC} 
paragraphDescriptor: TParaDescri ptor 
characterDescriptor: TChar Descriptor 
maxDataSi ze: INTEGER 
{$1 FC WithUObj ect } 
data: TString; 
{$ELSEC} 
data: TUTSt ring; 
{$ENDC} 
itsOurTString: BOOLEAN 


{$1 FC WithUObj ect } 
FUNCTION {TTKUnivText. }CREATE( obj ect: TObj ect; 
itsHeap: THeap; 
itsTString: TString 
itsDataSize: INTEGER) : TTKUnivText; 
{$ELSEC} 
FUNCTION {TUnivText. }CREATE( object: TUTObj ect; 
itsHeap: THeap; 
itsTString: TUTString; 
itsDataSize: INTEGER) : TUnivText; 
{$ENDC} 
PROCEDURE {TUnivText. }Free; OVERRIDE; 
PROCEDURE {TUnivText. }RunToStream 
PROCEDURE {TUnivText. }StreamToTRun; 
PROCEDURE {TUnivText. }TabTabl eToArgThd; 
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000236 
000237 
000238 
000239 
000240 
000241 
000242 
000243 
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000253 
000254 
000255 
000256 
000257 
000258 
000259 
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000261 
000262 
000263 
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000265 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 
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PROCEDURE {TUnivText. }ArgTbdToTabTabl e; 


END; 


{$1 FC WithUObj ect } 


TTKReadUnivText = SUBCLASS OF TTKUnivText 


{$ELSEC} 
TReadUni vText = SUBCLASS OF TUnivText 
{$ENDC} 
{$1 FC WithUObj ect } 
buffer: TString; 
{$ELSEC} 
buffer: TUTString; 
{$ENDC} 
columnCount: | NTEGER; 


dataBeforeTab: BOOLEAN 


{$1 FC WithUObj ect } 


FUNCTION {TReadUnivText. 


{$ELSEC} 


FUNCTION {TReadUnivText. 


{$ENDC} 


PROCEDURE {TReadUni vText. 
PROCEDURE {TReadUnivText. 
PROCEDURE {TReadUnivText. 


PROCEDURE {TReadUnivText. 


FUNCTION {TReadUnivText. 


}CREATE( object: TObj ect; 
itsHeap: THeap; 
itsTString: TString 
itsDataSize: INTEGER 
Level OfGranularity: TLevel OfGranul arity) 
: TTKReadUni vText 


}CREATE( obj ect: TUTObj ect; 
itsHeap: THeap; 
itsTString: TUTString; 
itsDataSize: INTEGER 
Level OfGranularity: TLevel OfGranularity) 
: TReadUnivText; 


}Free; OVERRIDE; 
}ReadRun; { Returns one run of text each time called } 
}Restart; { Resets the object to read fromthe begining } 


}ScanTabl e( VAR rows, 
tabCol umns, 
tabStopColumns: INTEGER); 
{ Returns number of rows and colums of scrap if a valid table } 


}ReadFiel d( maxFieldSize: INTEGER; 
VAR fieldOverflow: BOOLEAN 

VAR fieldTermi nator: CHAR; 

VAR tabType: TTabTypes) 

: BOOLEAN; 
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000284 { Returns one field of text each time called } 
000285 

000286 FUNCTION {TReadUnivText. }ReadLi ne( maxLineSize: INTEGER 

000287 VAR lineOverflow: BOOLEAN 

000288 VAR lineTermi nator: CHAR) 

000289 : BOOLEAN: 
000290 { Returns one line of text each time called } 
000291 FUNCTION {TReadUnivText. }GetParaPicture(heap: THeap) 

000292 : PicHandle: 
000293 { Copies the picture for the current paragraph into heap } 
000294 END; 

000295 

000296 

000297 {$l1FC WthUObj ect} 

000298 TTKWriteUnivText = SUBCLASS OF TTKUnivText 

000299 {$ELSEC} 

000300 TWriteUnivText = SUBCLASS OF TUnivText 

000301 {$ENDC} 

000302 

000303 {$l1FC WthUObj ect} 

000304 FUNCTION {TWriteUnivText. }CREATE( object: TObj ect 

000305 itsHeap: THeap; 

000306 itsTString: TString 

000307 itsDataSize: | NTEGER) 

000308 : TTKWiteUnivText; 
000309 {$ELSEC} 

000310 FUNCTION {TWriteUnivText. }CREATE( object: TUTObj ect; 

000311 itsHeap: THeap; 

000312 itsTString: TUTString; 

000313 itsDataSize: | NTEGER) 

000314 : TWriteUnivText; 
000315 {$ENDC} 

000316 PROCEDURE {TWriteUnivText. }Fill Paragraph; {Writes one run of text each time called} 
000317 END; 

000318 

000319 {$1FC NOT WthUObj ect} 

000320 FUNCTION NewUTObject(heap: THeap; itsClass: TClass): TUTObj ect; 

000321 {$ENDC} 

000322 

000323 {$lFC f Universal TextTrace} 

000324 VAR 

000325 fPrintSecrets: BOOLEAN: 

000326 {$ENDC} 

000327 

000328 | MPLEMENTATI ON 

000329 

000330 {$l1FC fDbg0k} 

000331 {$R+} 
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ELSEC} 


SETC doTraceUT := FALSE} 
‘) 


S TKUTMai n} 
ELSEC} 

S$ UTMai n} 
ENDC} 


{$l libut/UUnivText2. text} 


1FC WithUObj ect } 
S$ TKUTI nit} 
ELSEC} 

§ UTI nit} 


$ 
$ 
$ 
$ 
$ 
$ 
$ 
$ 
$ 
$ 
$1 FC WithUObj ect} 
$ 
$ 
$ 
$ 
$ 
$ 
$ 
$ 
$ 
$ENDC} 


File -- Lines: 359 Characters: 13021 


etC fTraceUT := doTraceUT AND fUniversal TextTrace} 
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FILE: 


"LI BTK/ XFER. TEXT" 


000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 


000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 


000040 
000041 
000042 
000043 


; UNIT XFER; {Copyright 1983, 1984 Apple Computer, Inc. } 


{changed 01/20/83 2026 
{changed 01/05/83 2149 


Added Equal Bytes 


Here we still have (in SgCLAres) 
LintDivlLint, Ll ntDivint, Lint Mull nt, 
XferLeft, XferRight, RotatePattern, 
{changed 01/01/83 2000 7 
Replaced IsJsr by % Next Method 
Deleted XPNewMet hod: 


Li ntAndLi nt, 
EnterLisabug} 
Added %JmpTo, % ExitCaller, % ExitFunny, % Call Method, % Super; 


Moved several routines to CLASLIB so they can go into PASLIB; 


Li ntOrLi nt, 


Changed Segment from SgABCres to SgCLAres & added some SgCLAini procedures 
Added $D information conditioned on DEBUGF flag 
(Note: SP=A7) } 
{changed 09/13/83 1115 RELEASE TK7D TO TOOLKIT TEAM} 
{changed 08/30/83 2000 RELEASE TK7C TO TOOLKIT TEAM} 
DEBUGE »EQU 1 ' 1 to include $D+ info, 0 to exclude it 
. MACRO HEAD 
. | F DEBUGF 
LI NK A6, #0 ; These two instructions forma slow no-op 
MOVE.L (SP) +, A6 
. ENDC 
. ENDM 
. MACRO TAIL 
. LF DEBUGF 
UNLK A6 
RTS 
-ASCII = 6% 
. ENDC 
. ENDM 
SEG 'SgXFER 
. PROC XFERLEFT 
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PROCEDURE XferLeft(source, dest: TP; nBytes: INTEGER) 


uses AO, Al, DO, D1 


MOVE. 
MOVE. 
MOVE. 
MOVE. 
MOVE. 


L 
W 
L 
L 
L 


SUB. W 


BLT. S$ 


XFER MOVE. 


DBF 


RTSLEFT RTS 


(SP) +, D1 + POP RETURN ADDRESS 

(SP) +, DO + DO := NBYTES 

(SP) +, Al + Al := DEST 

(SP) +, A0 + AO := SOURCE 

D1, - (SP) + PUSH RETURN ADDRESS FOR RTS 
#1, DO + DECREMENT NBYTES 

RTSLEFT ‘ NBYTES <= 0, SO EXIT 
(A0) +, (Al) + 

DO, XFER 

'XFERLEFT 


» PROC XFERRI GH 


HEAD 


PROCEDURE XferRight(source, dest: TP; nBytes: I NTEGER) 


uses AQ, Al, DO, D1 


MOVE. 
MOVE. 
MOVE. 
MOVE. 
MOVE. 


L 
W 
L 
L 
L 


TST. W 


BLE. S 


ADDA. 
ADDA. 


W 
W 


SUB. W 


(SP) +, D1 + POP RETURN ADDRESS 

(SP) +, DO + DO := NBYTES 

(SP) +, Al + Al := DEST 

(SP) +, A0 + AO := SOURCE 

D1, - (SP) + PUSH RETURN ADDRESS FOR RTS 
DO + TEST NBYTES 

RTSRI GH ' NBYTES <= 0, SO EXIT 

DO, AO + START AT RIGHT END 

DO, Al 

#1, DO + DECREMENT NBYTES 
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000092 
000093 
000094 
000095 
000096 
000097 
000098 
000099 
000100 
000101 
000102 
000103 
000104 
000105 
000106 
000107 
000108 
000109 
000110 
000111 
000112 
000113 
000114 
000115 
000116 
000117 
000118 
000119 
000120 
000121 
000122 
000123 
000124 
000125 
000126 
000127 
000128 
000129 
000130 
000131 
000132 
000133 
000134 
000135 
000136 
000137 
000138 
000139 


XFER MOVE. 
DBF 

RTSRIGH RTS 
TAIL 


-(A0),- (Al) 


DO, XFER 


' XFERRI GH’ 
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. PROC Equal Bytes 


HEAD 


MOVE. 
MOVE. 
MOVE. 
MOVE. 
MOVE. 


MOVE. 


L 
W 
L 
L 
L 


SUB. W 


BLT. S$ 
XFER MOVE. 
CMP. B 
BNE 
DBF 
RTSEQUL RTS 


UNEQUL CLR. B 


uses AQ, Al, DO, D1 


(SP) +, D1 
(SP) +, DO 
(SP) +, Al 
(SP) +, A0 
D1, - (SP) 


#1, 4( SP) 
#1, DO 
RTSEQUL 
(A0) +, D1 
(A1) +, D1 


UNEQUL 
DO, XFER 


4( SP) 


" EQUALBYT 


PROCEDURE Equal Bytes(source, dest: TP; nBytes: INTEGER); 


POP RETURN ADDRESS 


DO := NBYTES 
Al := DEST 
AO := SOURCE 


PUSH RETURN ADDRESS FOR RTS 
RETURN TRUE UNLESS PROVEN UNEQUAL 
DECREMENT NBYTES 

NBYTES <= 0, SO EXIT 


RETURN FALSE 


. PROC ROTATEPA 


HEAD 


; PROCEDURE RotatePattern(plnPat, pOutPat: “Pattern; dh, dv: LONGINT); 
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000140 
000141 
000142 
000143 
000144 
000145 
000146 
000147 
000148 
000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
000158 
000159 
000160 
000161 
000162 
000163 
000164 
000165 
000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 
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uses AQ-A2, DO- D4 


MOVEM. L (SP) +,D0-D2/A0-Al ; DO := RETURN ADDRESS, D1 := dv; D2 := dh, AO := pOutPat, Al 
MOVE.L DO, - (SP) ; PUSH RETURN ADDRESS FOR RTS 
MOVEM. L A2/D3-D4, - (SP) ; Save A2, D3, D4 
AND. L #7, D2 ; dh := dh MOD 8 

***** FOR D3 := 7 DOWNTO 0 DO ***** 
MOVE. W #7, D3 ; Loop count 

AREER BEGIN ***** 

RLOOP MOVE.B $00(A1,D3.W),D0 ; DO := next byte in inPat 

ROL. B D2, DO ; Rotate byte in DO left by D2 (dh) 
MOVE. W D3, D4 
SUB.W D1, D4 
AND. W #7, D4 ; D4 := (D3 - dv) MOD 8 
MOVE.B D0, $00(A0,D4.W) ; next byte in outPat := DO 
DBF D3, RLOOP 

eeeee END: eee 
MOVEM. L (SP)+,A2/D3-D4 ; Restore A2, D3, D4 
RTS 
TAIL ‘ROTATEPA 
» FUNC LINTDIVL 
HEAD 

FUNCTION LintDivLint(i, j: LONGINT): LONGI NT; 


uses AQ, DO, D1 


» REF 


LD 
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000188 
000189 
000190 
000191 
000192 
000193 
000194 
000195 
000196 
000197 
000198 
000199 
000200 
000201 
000202 
000203 
000204 
000205 
000206 
000207 
000208 
000209 
000210 
000211 
000212 
000213 
000214 
000215 
000216 
000217 
000218 
000219 
000220 
000221 
000222 
000223 
000224 
000225 
000226 
000227 
000228 
000229 
000230 
000231 
000232 
000233 
000234 
000235 
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ion 


* Return address 


; DO: 
' Dl: 


i 


; Is j too long to use LintDivint? 
big 


; Too 


: Too small 
+ Can't BGT LD in this assembler 


MOVE.L (SP) +, A0 
MOVE.L (SP) +, D0 
MOVE.L (SP) +,D1 
CHEK CMP.L #32767, DO 
BGT TOOLONG 
CMP.L #-32768, DO 
BLT TOOLONG 
) MP LD 
TOOLONG ASR.L #1, DO 
ASR.L = #1,D1 
) MP CHEK 
TAIL “LENTDIVL' 
FUNC LINTDI VI 
HEAD 
FUNCTION LintDivint(i: 


. DEF 
MOVE. L 


MOVE. W 
MOVE. L 


LD 
BEQ 


MOVE. L 
MOVE. W 


CLR.L 
TST. W 


BGE 


NEG, W 
NEG. L 


J POS 


CMP. W 


TST.L 


uses AO, DO, D1, D2 


LD 
(SP) +, A0 


(SP) +, DO 
(SP) +, D1 


2( SP) 
2( SP) 


LONGINT; j: 


NTEGER): LONGI NT; 


* Return address 


; DO: 
' Dl: 


= 1, return i 


+ Push i as LONGI NT 
; Push j as INTEGER 


: If 


j 


is negative, negate both 


; negate j 
; negate i 


: If 


is negative, negate it but remember it was 


Apple Lisa ToolKit 3.0 Source Code Listing 


945 of 


1012 


000236 
000237 
000238 
000239 
000240 
000241 
000242 
000243 
000244 
000245 
000246 
000247 
000248 
000249 
000250 
000251 
000252 
000253 
000254 
000255 
000256 
000257 
000258 
000259 
000260 
000261 
000262 
000263 
000264 
000265 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 


POS MOVE. W 


DUN ADD.L 


DVI MOVE. L 
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D2 i 
1 POS 
2( SP) i 


2(SP), D1 i 
(SP), D1 


D1, DO i 
4(SP), D0 i 
(SP) +, DO : 


D1 i 
DO, D1 i 


D2 i 
DUN 

D1 

#4, SP i 
D1, (SP) H 
( AQ) H 


“LINTDIVI' 


D2 := (i < 0) 

negate i 

Divide MSW of i by j 

Remainder becomes MSW of next Divide 

Divide ((preceding remainder) concat (LSWof i)) by j 


Pop j at the same time 


Quotient of first divide is MSW of result 
Quotient of second divide is LSW of result 


Was i negative? 


Popeye 
Store function result 


Return 


» FUNC LINTMULI 


HEAD 


FUNCTION LintMull nt(i: LONGI NT; 


uses AO, DO, D1, D2 


MOVE. L 


MOVE. W 
MOVE. L 


CMP. W 
BEQ 


MOVE. L 


MOVE. W 
S WAP 


(SP) +, A0 ; 


(SP) +, D1 i 
(SP) +, DO } 


#1, D1 i 
MU1 


D2,-(SP) i 


DO, D2 i 
DO i 


j: INTEGER): LONGI NT; 


Return address 


IF j = 1, return 


Save D2 
D2 := LSW of | 
DO : = MSW of 
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000284 
000285 
000286 
000287 
000288 
000289 
000290 
000291 
000292 
000293 
000294 
000295 
000296 
000297 
000298 
000299 
000300 
000301 
000302 
000303 
000304 
000305 
000306 
000307 
000308 
000309 
000310 
000311 
000312 
000313 
000314 
000315 
000316 
000317 
000318 
000319 
000320 
000321 
000322 
000323 
000324 
000325 
000326 
000327 
000328 
000329 
000330 
000331 


MULU D1, DO 
LSL.L #8, DO 
LSL.L #8, DO 
MULU D1, D2 
ADD.L D2, D0 


MOVE.L (SP)+, D2 


MU1 MOVE.L DO, (SP) 
) MP ( A0) 
TAIL "LINTMULI 
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; DO := DO * j 
; DO := product 
; restore D2 


: Store function result 


; Return 


» FUNC LINTANDL 
HEAD 


FUNCTION LintAndLint(i, j: LONGINT): LONGI NT; 


uses AO, DO 


MOVE.L (SP) +, A0 


MOVE.L (SP) +, D0 
AND.L (SP) +, D0 


MOVE.L DO, (SP) 
) MP ( A0) 


TAIL "LINTANDL 


' Return address 


; DO: 
; DO: 


= j 
= i AND j 
: Store function result 


; Return 


» FUNC LINTORLI 
HEAD 


FUNCTION LintOrLIint(i, j: LONGINT): LONGI NT 


uses AO, DO 


MOVE.L (SP) +, A0 


* Return address 
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000332 
000333 
000334 
000335 
000336 
000337 
000338 
000339 
000340 
000341 
000342 
000343 
000344 
000345 
000346 
000347 
000348 
000349 
000350 
000351 
000352 
000353 
000354 
000355 
000356 
000357 
000358 
000359 
000360 
000361 
000362 
000363 
000364 
000365 
000366 
000367 
000368 
000369 
000370 
000371 
000372 
000373 
000374 
000375 
000376 
000377 
000378 
000379 


Apple Lisa Computer Technical 


Information 


MOVE.L (SP) +, D0 i 
OR.L (SP) +, DO i 


MOVE.L D0, (SP) ; 
) MP ( A0) i 
TAIL "LINTORLI 


DO: 
DO: 


j 
i OR j 


Store function result 


Return 


» FUNC LINTXORL 
HEAD 


uses AQ, DO, D1 


MOVE.L (SP) +, A0 i 
MOVE.L (SP) +, DO i 
MOVE.L (SP)+, D1 ; 
EOR.L D1, D0 : 
MOVE.L D0, ( SP) ; 
) MP ( A0) i 


TAIL *LENTXORL 


FUNCTION LintXorLint(i, j: LONGINT): LONGI NT; 


Return address 


DO: 
Dl: 
DO: 


| 
I 
i XOR j 


Store function result 


Return 


» PROC ENTERLIS 
HEAD 


; PROCEDURE EnterLisabug 


TRAP #0 

RTS 

TAIL ‘ ENTERLIS' 
_ END 
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000380 
000381 


End of File -- Lines: 381 Characters: 9390 
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000001 {$SETC PasteTrace := PasteTrace AND f Universal TextTrace} 


000002 

000003 CONST 

000004 magicTabMax= itbdLst; {The maximum number of tabstops on a ruler allowed by LisaWrite and its ilk} 
000005 maxBacking = 12; {Maximum number of chars saved for backing up the I pLim during Write UT} 
000006 

000007 TYPE 

000008 TPtrTool KitUT = “Tool Ki tUT; 

000009 Tool KitUT = Tcs; 

000010 TSavedPara = RECORD 

000011 firstLp: TLp; 

000012 theArce: TArce; 

000013 theArpe: TAr pe; 

000014 {$lFC WthUObj ect} 

000015 theText: TString; 

000016 {$ELSEC} 

000017 theText: TUTString; 

000018 {$ENDC} 

000019 END; 

000020 PSavedPara = A“TSavedPara; 

000021 HSavedPara = “PSavedPara; 

000022 

000023 {$lFC NOT WthUObj ect} 

000024 Byte = -128..127; 

000025 TpLONGINT = “LONGI NT 

000026 TPByte = “Byte; 

000027 {$ENDC} 

000028 

000029 {private types not used in the Toolkit; used in place of the Toolkit's type coercion to a 

000030 Handle, since a Handle outside of the Toolkit is a double-indeirect pointer to a byte} 
000031 UTpLongint = *LONGI NT; 

000032 UTppLongint = *UTpLongi nt; 

000033 

000034 { Carefull, carefull, carefull here kids. Since | can't have private fields and/or methods in my classes 
000035 inorder to resolve a few types | amforced to do this thing to keep you innocents from having to 
000036 include an ugly list of units. Only one instance of these variabes exists ever! Therefore | can only 
000037 do things one at a time, } 

000038 

000039 TSecretThings = RECORD 

000040 streamArrayl ndex: Byte; 

000041 I pd: TALpd; 

000042 achad: TAchad: 

000043 END; 
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000044 

000045 VAR 

000046 {$l1FC WthUObj ect} 

000047 activeStream TTKWriteUnivText; 
000048 {$ELSEC} 

000049 activeStream TWiteUnivText; 
000050 {$ENDC} 

000051 secrets: TSecretThings 
000052 currentLpd: TLpd; 

000053 datal ndex: INTEGER 

000054 dataLp: TLp; 

000055 savedPara: ARRAY [1..maxBacking] OF HSavedPara; 
000056 nOf SavedPara: 0.. maxBacking 
000057 {$l1FC WthUObj ect} 

000058 theData: TString 

000059 {$ELSEC} 

000060 theData: TUTStri ng 
000061 {$ENDC} 

000062 

000063 {$l1FC NOT WthUObj ect} 

000064 


000065 {The following is a pTool Kit to avoid including lots of code that is not used by non-Tool Kit applications. } 
000066 
000067 
000068 


{$1 FC WithUObj ect } 
{$$ TKUTMai n} 
000069 {$ELSEC} 
000070 {$$ UTMai n} 
000071 {$ENDC} 
G00072> Jusetcasetetseteieeecteceated ta au les tnceatna setae eh ane gietne canine weaves acne eee mead ine cuennacuelnmmuel as } 
000073 PROCEDURE UTXferRight(source, dest: Ptr; nBytes: INTEGER); EXTERNAL; 
000074 PROCEDURE UTXferLeft(source, dest: Ptr; nBytes: INTEGER); EXTERNAL; 


ONO TS: te ee iatec sin ene s des aces rare anede sate wei aie ho doo carw Ara Soaresadtnhatevenhenl ore wtp che ceaen Matera Soteckn one. enrs teace mG Recent emt Cerecantareme Oaie } 
000076 

000077 {$1FC WthUObj ect} 

000078 {$$ TKUTMai n} 

000079 {$ELSEC} 

000080 {$$ UTMain} 

000081 {$ENDC} 

0 ae Cee eee er ee te er ee ce ee eer eto ee eee eee re eee Seren terre eer cect } 
000083 FUNCTION Min(i, j: LONGINT): LONGI NT; 

CC) i oe eT ee ee ere ee ee eee eee eC. ee eee ee } 
000085 BEGIN 

000086 {$IlFC fTraceUT} LogCall; {$ENDC} 

000087 IF i <j THEN 

000088 Min := i 

000089 ELSE 

000090 Min := j 


000091 END; 


Apple Lisa ToolKit 3.0 Source Code Listing -- 951 of 1012 


Apple Lisa Computer Technical Information 


000092 

000093 

000094 {$l1FC WthUObj ect} 

000095 {$$ TKUTMai n} 

000096 {$ELSEC} 

000097 {$$ UTMai n} 

000098 {$ENDC} 

CL a eee ee er ee. ee ee ee ee ee eee eer re ee eee et cee 
000100 FUNCTION Max(i, j: LONGI NT): LONGI NT; 

C0010 tateta sete seats ea aatiasy ce sene saan s tana sacind ne gina na cecne op a Sacmene ensue me en omsumcnecmammanares 
000102 BEGIN 

000103 {$lFC fTraceUT} LogCall; {$ENDC} 

000104 IF i > j THEN 

000105 Max := i 

000106 ELSE 

000107 Max := j 

000108 END; 

000109 

000110 

000111 {$l1FC WthUObj ect} 

000112 {$$ TKUTI nit} 

000113 {$ELSEC} 

000114 {$8 UTI nit} 

000115 {$ENDC} 

O00 T1G. fame a tina ede useuinc oe cws wel mayen. ge otis cepa nis pee niet ea tiple oalee da Dele e Salome Beeig SDE MEte ae ee ae Ween ene s age esiee 
000117 PROCEDURE ABCBreak(s: $255; errCode: LONGI NT) 

i i oe ee et eer re er ee ee ec r , e  e cr e eeee 
000119 BEGIN 

000120 {$lFC fTraceUT} LogCall; {$ENDC} 

000121 {$1 FC fDbgObj ect} 

000122 WiteLn; 

000123 Write(CHR(7), s); {Beep} 

000124 IF errCode <> 0 THEN 

000125 Write(': ', errCode:1) 

000126 WriteLn; 

000127 {$ENDC} 

000128 HALT; 

000129 END; 

000130 

000131 

000132 {$1FC WthUObj ect} 

000133 {$$ TKUTI nit} 

000134 {$ELSEC} 

000135 {$$ UTI nit} 

000136 {$ENDC} 

O00 ET fees tect bectetecunnnte te cde dieiGbsads dreds leas ee gGiee alts cee c ake eeekee Ae Reet ie and aetiies 
000138 PROCEDURE SetCp(object: TUTObject; itsClass: TClass); 

O00189: Seance nac es nen eu Se stele sane man ne eaauaie ance aie ears Regie RReN a acon hal eek ea amle yaan cite enchant ala @anc ti 
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000140 
000141 
000142 
000143 
000144 
000145 
000146 
000147 
000148 
000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
000158 
000159 
000160 
000161 
000162 
000163 
000164 
000165 
000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 
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VAR index: INTEGER 
BEGIN 
{$1 FC fTraceUT} LogCall; {$ENDC} 
UTppLongi nt(object)** := ORD(itsClass); {Install slice table pointer} 
index := CiOfCp(TPSliceTable(itsClass)); {Determine its class index} 
IF index < 256 THEN {If it will fit in a byte, store it... } 
TPByte(UTppLongi nt(object)*)* := index; {...to speed version conversion (cf ConvertHeap: FindCl asses) } 


$1 FC WithUObj ect} 
$$ TKUTMai n} 
$ELSEC} 


FUNCTION NewDynObject(heap: THeap; itsClass: TClass; dynBytes: INTEGER): TUTObj ect; 


VAR nBytes: INTEGER 
object: TUTObject; 
BEGIN 
{$1 FC fTraceUT} LogCall; {$ENDC} 
nBytes := SizeOfCp(TPSliceTable(itsClass)) + dynBytes; 
object := POINTER(ORD( HAI | ocate(THz(heap), nBytes))); {TUTObject() won't work until after SetCp} 
IF ORD(object) = ORD(hNIL) THEN 
ABCBreak('NewObj ect: Heap full, can''t make an object of size', nBytes); 
SetCp(object, itsClass); 
NewDynObj ect := object; 
END; 


$1 FC WithUObj ect} 
$$ TKUTMai n} 
$ELSEC} 

$$ UTMai n} 
{$ENDC} 


{ 
{ 
{ 
{ 


BEGIN 

{$1 FC fTraceUT} LogCall; {$ENDC} 
NewUTObj ect := NewDynObject(heap, itsClass, 0) 

END; 


{$1 FC WithUObj ect} 
{$8 TKUTMai n} 
{$ELSEC} 
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000188 {$$ UTMain} 
000189 {$ENDC} 


i eee en eter er eee eee ee ee ee er eee reer ener rr eer 
000191 PROCEDURE ResizeDynObject(object: TUTObject; newTotal Bytes: | NTEGER) 

GO OTD: Serena genre mals tee a nh balan CMa e Mean Red whl easel my adinGs Barak mrad Race aroha Os eae owmae naan pean ele amare 
000193 VAR i: INTEGER 

000194 BEGIN 

000195 {$l FC fTraceUT} LogCall; {$ENDC} 

000196 IF (newTotal Bytes < 0) OR (newTotal Bytes > ( MAXINT-20)) THEN 

000197 ABCBreak('New size must lie between 0 and 32K-20, not', newTotal Bytes); 

000198 ChangeSi zeH(THz(object.Heap), TH(object), newTotal Bytes); 

000199 1F ChDataOfH( THz(object.Heap), TH(object)) < newTotalBytes THEN 

000200 ABCBreak('ResizeDynObj ect: Heap full, size can''t change to', newTotal Bytes); 

000201 END; 

000202 

000203 

000204 {$lFC WthUObj ect} 

000205 {$8 TKUTMai n} 

000206 {$ELSEC} 

000207 {$S UTMai n} 

000208 {$ENDC} 

000209 fie ta been tice teactinciente ie nkitee iene icgesieohndeen tee ieaaiiee ties gemesitned tie iibed ties 
000210 FUNCTION ClassPtr(hndl: UTppLongint): TClass 

QUIT) Yetact ace ce tetead aera a eray ena ganeamnse abelne gu cmmaraitencd aimee Wola wee aenbace Maat eaMenecmolnbenctas 
000212 VAR stp: RECORD 

000213 CASE INTEGER OF 

000214 1: (asLong: LONGI NT); 

000215 2: (asBytes: PACKED ARRAY [0..3] OF TByte) 

000216 3: (asClass: TClass); 

000217 END; 

000218 BEGIN 

000219 {$lFC fTraceUT} LogCall; {$ENDC} 

000220 stp.asLong := hndl **; 

000221 stp. asBytes[0] := 0; 

000222 ClassPtr := stp. asClass 

000223 END; 

000224 

000225 

000226 {$lFC WthUObj ect} 

000227 {$8 TKUTMain} 

000228 {$ELSEC} 

000229 {$S UTMai n} 

000230 {$ENDC} 

O00231, S[eeeeteheeauece ence tec mnee ae eres nhmnons deo Supe ky wie s arsenic saree nee ea pW ie a eu.ceains otal eh dine Saige 
000232 FUNCTION SizeOfClass(class: TClass): INTEGER 

(Ve or ne ee er errr ee eer ee re ee cee er ert ey se 
000234 BEGIN 

000235 {$lFC fTraceUT} LogCall; {$ENDC} 
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000236 SizeOfClass := SizeOfCp(TPSIiceTabl e(cl ass) ) 

000237 END; 

000238 

000239 

000240 {$1FC WthUObj ect} 

000241 {$$ TKUTI nit} 

000242 {$ELSEC} 

000243 {$8 UTI nit} 

000244 {$ENDC} 

Cp ae Oe ee ee ee ee ee ee eee er ee ee eee ee eee eee rene ee 
000246 PROCEDURE Init Obj ect; 

Q0020) feeettecanitcraneect heel ceelateeh oreiGided seteethoth idee tieeiicactneatan gamenine teed ees 
000248 BEGIN 

000249 {$lFC fTraceUT} LogCall; {$ENDC} 

000250 {Do very little for the time beeing} 

000251 END; 

000252 

000253 

000254 {$l1FC WthUObj ect} 

000255 {$8 TKUTI nit} 

000256 {$ELSEC} 

000257 {$$ UTI nit} 

000258 {$ENDC} 

O00759 . Peter taser semece tet eane irate saat taakales elas a ekaa ahaa anteccalne eye e Seine eretn erent nammngendas } 
000260 PROCEDURE ClascalError(error: INTEGER); {called with error = 0 after successful Clascal initialization} 
Q002 61 od ixa st iecuey Natit eee aerate Minette ho edad mentee eatemm eae wea ain baleen arches atu eran 
000262 BEGIN 

000263 {$lFC fTraceUT} LogCall; {$ENDC} 

000264 IF error > 0 THEN 

000265 ABCBreak('Some kind of Clascal error', error) 

000266 END; 

000267 

000268 

000269 METHODS OF TUTObj ect; 

000270 

000271 {$l1FC WthUObj ect} 

000272 {$$ TKUTMai n} 

000273 {$ELSEC} 

000274 {$$ UTMai n} 

000275 {$ENDC} 

000276 Sere ee ee ee ee eee ee See ee ee ee oe ee ee eee et ee ee 
000277 PROCEDURE {TObj ect. }Free 

000278 {i Sina orca eect Gai eet ee ie oN te ee Ce eae ete hat ates aaa eee eae 
000279 BEGIN 

000280 {$lFC fTraceUT} LogCall; {$ENDC} 

000281 SELF. FreeQbj ect; 

000282 END; 

000283 
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000284 

000285 {$l1FC WthUObj ect} 

000286 {$$ TKUTMain} 

000287 {$ELSEC} 

000288 {$8 UTMai n} 

000289 {$ENDC} 

000290 Ser ee eee ey ee Tee TE Te TEE eee eT OSE C Ree Ce OL ee nee one Pee Cone ee ee ee 
000291 PROCEDURE {TObj ect. }FreeObj ect 

000292 ee een a ee ee ae ee ee ee ee ere eee ee ee ee er ae 
000293 VAR heap: THeap; 

000294 BEGIN 

000295 {$lFC fTraceUT} LogCall; {$ENDC} 

000296 heap := SELF. Heap; 

000297 FreeH(THz( heap), TH(SELF)); 

000298 END; 

000299 

000300 

000301 {$l1FC WthUObj ect} 

000302 {$8 TKUTMain} 

000303 {$ELSEC} 

000304 {$8 UTMai n} 

000305 {$ENDC} 

000306 Merry terre errr eT eT er Ce ET eT eee TN err ee ere Tre eT Per NT eC eE NEE eer ee ree re rer ree 
000307 FUNCTION {TObj ect. }Heap: THeap; 

000308 {ruGec nn wcahlsc en's setae aea’s nc ee Eecan yh sie SucueG ec iews ony heteyeGulens Veep signs Hebe segues slay egee's 
000309 BEGIN 

000310 {$l FC fTraceUT} LogCall; {$ENDC} 

000311 Heap := THeap(HzFromH( TH( SELF) )); 

000312 END; 

000313 

000314 

000315 {$l1FC WthUObj ect} 

000316 {$$ TKUTMain} 

000317 {$ELSEC} 

000318 {$8 UTMai n} 

000319 {$ENDC} 

000320 ree ee ee ere Tee ee ee ee ee ee ee Ter eee ee ee ee ee ere 
000321 FUNCTION {TObject.}Class: TClass 

000322 ee enn eer en nee eee eee ere eee ee eee ee eee ee eee ee cee eee ee ree 
000323 BEGIN 

000324 {$lFC fTraceUT} LogCall; {$ENDC} 

000325 Class := ClassPtr(UTppLongi nt (SELF) ); 

000326 END; 

000327 

000328 

000329 1FC WithUObj ect } 


{$ 
000330 {$$ TKUTInit} 
000331 {$ELSEC} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 956 of 1012 


000332 
000333 
000334 
000335 
000336 
000337 
000338 
000339 
000340 
000341 
000342 
000343 
000344 
000345 
000346 
000347 
000348 
000349 
000350 
000351 
000352 
000353 
000354 
000355 
000356 
000357 
000358 
000359 
000360 
000361 
000362 
000363 
000364 
000365 
000366 
000367 
000368 
000369 
000370 
000371 
000372 
000373 
000374 
000375 
000376 
000377 
000378 
000379 
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{$$ UTI nit} 

{$ENDC} 

BEGIN {Class Initialization} 

{$1 FC fTraceUT} LogCall; {$ENDC} 
InitClascal(ClascalError); {Provide an error routine in case of errors in Clascal run-time support} 
Init Object; {Do remaining initialization} 

END; 

METHODS OF TUTColl ection; 


{$1 FC WithUObj ect } 
{$$ TKUTMai n} 
{$ELSEC} 
{$$ UTMai n} 
{$ENDC} 
FUNCTION {TCollection. }}CREATE(object: TUTObject; heap: THeap; initial Slack: INTEGER): TUTCollection; 
BEGIN 
{$I FC fTraceUT} LogCall; {$ENDC} 
IF object = NIL THEN 
ABCBreak('TUTCollection. CREATE must be passed an already-allocated object by a subclass CREATE’, 0); 
SELF := TUTCollecti on( obj ect); 
WITH SELF DO 
BEGIN 
size := 0: 
{$H-} dynStart := SizeOfClass(SELF.Class); {$H+} 
holeStart := 0; 
holeSize := initial Slack 
holeStd := 0; 
END; 
END; 
{$1 FC WithUObj ect } 
{$$ TKUTMai n} 
{$ELSEC} 
{$$ UTMai n} 
{$ENDC} 
Mere teen e Tee rT eC eter eT eR ITT Err rT eee ee err er Tey eee Eee eT eT NET Tee ey eee eee eee ree cre } 
FUNCTION {TCollection. }AddrMember(i: LONGINT): LONGINT; 
{avec ance ameeteechentslhexphetalenee hes ar vaca cuhcae ets aoe inate eee ae toda gsi d epee epcmeeee pee sans } 
BEGIN 
{$l FC fTraceUT} LogCall; {$ENDC} 
IF i > SELF. holeStart THEN 
i :=i + SELF. holeSize 
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000380 
000381 
000382 
000383 
000384 
000385 
000386 
000387 
000388 
000389 
000390 
000391 
000392 
000393 
000394 
000395 
000396 
000397 
000398 
000399 
000400 
000401 
000402 
000403 
000404 
000405 
000406 
000407 
000408 
000409 
000410 
000411 
000412 
000413 
000414 
000415 
000416 
000417 
000418 
000419 
000420 
000421 
000422 
000423 
000424 
000425 
000426 
000427 
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AddrMember := TpLONGINT(SELF)* + SELF. dynStart + (SELF.MemberBytes * (i - 1)); 


END; 
{$1 FC WithUObj ect } 
{$$ TKUTMai n} 
{$ELSEC} 
{$$ UTMai n} 
{$ENDC} 
eer ee eee eee oe ee ee ere ee ee eee eee er ee eee ee } 
PROCEDURE {TCollection. }EditAt(atI ndex: LONGINT; deltaMembers: INTEGER); 
hakeradutanghacaduce a tann duce tesaca te’ eau ar aducovaean'asatavne taste sbneseeane a Goer wdelie Ponta(a te acateat bier scab ors aauuahe ta tute aralarase: bgiatawetatetannbe  bbtaeeta ube dee: Senko } 
VAR ol dHoSi ze: INTEGER 
newHoSi ze: INTEGER 
ol dHoStart: INTEGER 
newHoStart: INTEGER; 
maxHoStart: INTEGER; 
mi nHoStart: INTEGER 
size: INTEGER; 
b: 0..1; 
BEGIN {Removes any hole it creates unless holdStd <> 0} 
{$1 FC fTraceUT} LogCall; {$ENDC} 


ol dHoSize := SELF. holeSize 
oldHoStart := SELF. hol eStart; 


IF (deltaMembers < 0) AND ((oldHoStart + 1) = atIndex) THEN {the hole is right before the deletion} 
SELF. holeStart := oldHoStart - deltaMembers 


ELSE 
BEGIN 
newHoStart := atindex - 1 - Min(deltaMembers, 0); 
1F (deltaMembers > ol dHoSize) OR (newHoStart <> oldHoStart) THEN 


BEGIN 
maxHoStart := Max(oldHoStart, newHoStart); 
newHoSize := Max(oldHoSize, deltaMembers); 


1F newHoSize > oldHoSize THEN 
BEGIN 
size := SELF.size; 
newHoSize := Max(newHoSize, SELF. holeStd); 
SELF. ResizeColl(size + newHoSi ze) 
SELF. ShiftColl(maxHoStart + oldHoSize, maxHoStart + newHoSize, size - maxHoStart); 
END; 


1F newHoStart <> oldHoStart THEN 
BEGIN 
b := ORD(newHoStart > ol dHoStart); {1 if hole is moving right and data is moving left} 
minHoStart := Min(oldHoStart, newHoStart); 
SELF. ShiftColl(minHoStart + oldHoSize*b, minHoStart + newHoSize*(1-b), maxHoStart - minHoStart) 
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000428 END; 

000429 

000430 SELF. holeStart := newHoStart; 

000431 SELF. holeSize := newHoSize 

000432 END; 

000433 END; 

000434 

000435 WITH SELF DO 

000436 BEGIN 

000437 size := size + deltaMembers 

000438 holeSize := holeSize - deltaMembers 

000439 holeStart := holeStart + deltaMembers 

000440 IF oldHoSize = 0 THEN 

000441 IF holeStd = 0 THEN 

000442 IF holeSize > 0 THEN 

000443 {$H- } SELF.StopEdit; {$H+} 

000444 END; 

000445 END; 

000446 

000447 

000448 {$1FC WthUObj ect} 

000449 {$8 TKUTMai n} 

000450 {$ELSEC} 

000451 {$8 UTMai n} 

000452 {$ENDC} 

000453 Pe ee See Re ee ee ET ee ee Oe ee Cae ee eer ee en ee ee ee Eee ee er ee } 
000454 PROCEDURE {TCollection. }Il nsManyAt(i: LONGINT; otherCollection: TUTCollection; index, howMany: LONGI NT); 
000455 {imap Gacwecad taunt ori tam eaves eeaisaa etoile oan Dame me ode SOM aN ae ae Dee ame oie ele dia mol attains } 
000456 VAR member Bytes: INTEGER 

000457 bef oreHole: INTEGER 

000458 srcAddr: LONGI NT; 

000459 dstAddr: LONGI NT; 

000460 j: | NTEGER; 

000461 offset: INTEGER; 

000462 BEGI N {Stops edit if it wasn't explicitly started} 
000463 {$lFC fTraceUT} LogCall; {$ENDC} 

000464 memberBytes := SELF. memberBytes 

000465 

000466 SELF. EditAt(i, howMany) 

000467 

000468 1F howMany > 0 THEN 

000469 IF otherCollection. Class = SELF.Class THEN {Can do it with at most two Xfers} 
000470 BEGIN 

000471 beforeHole := Min(howMany, otherCollection. holeStart + 1 - index); 

000472 

000473 srcAddr := otherColl ection. Addr Member( index); 

000474 dstAddr := SELF. Addr Member (i ) 

000475 IF beforeHole > 0 THEN 
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000476 
000477 
000478 
000479 
000480 
000481 
000482 
000483 
000484 
000485 
000486 
000487 
000488 
000489 
000490 
000491 
000492 
000493 
000494 
000495 
000496 
000497 
000498 
000499 
000500 
000501 
000502 
000503 
000504 
000505 
000506 
000507 
000508 
000509 
000510 
000511 
000512 
000513 
000514 
000515 
000516 
000517 
000518 
000519 
000520 
000521 
000522 
000523 
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BEGIN 
UTXferLeft(Ptr(srcAddr), Ptr(dstAddr), beforeHole * member Bytes); 


1F beforeHole < howMany THEN 
BEGIN 
srcAddr := srcAddr + (beforeHole + otherCollection.holeSize) * memberBytes; 
dstAddr := dstAddr + beforeHole * member Bytes; 
UTXferLeft(Ptr(srcAddr), Ptr(dstAddr), (howMany - beforeHole) * member Bytes); 


END; 
END 
ELSE 
UTXferLeft(Ptr(srcAddr), Ptr(dstAddr), howMany * memberBytes); 
END 
ELSE {Must Xfer each member separatel y} 
BEGIN 
offset := SELF.dynStart + (i - 1) * memberBytes; {AddrMember may even compact for all we know} 
FOR j := 1 TO howMany DO 
BEGIN 
UTXferLeft(Ptr(otherCollection. AddrMember(j)), Ptr( TpLONGINT(SELF)* + offset), memberBytes) 
offset := offset + member Bytes; 
END; 
END; 
END; 

{$1 FC WithUObj ect } 

{$5 TKUTMai n} 

{$ELSEC} 

{$$ UTMai n} 

{$ENDC} 
fis adie Oates wae a ence are aaa lee tired et Blea ane ae aan uae ak eae aes 
PROCEDURE {TColl ection. }ResizeCol!(membersPl usHole: INTEGER) 
ee nearer eer caer see ee ee ee rte rere re ee ere ore eee eee eC en } 
BEGIN 

{$1 FC fTraceUT} LogCall; {$ENDC} 

1F membersPlusHole <> (SELF.size + SELF. holeSize) THEN 
ResizeDynObject(SELF, SELF.dynStart + (membersPlusHole * SELF. Member Bytes) ); 
END; 

{$1 FC WithUObj ect } 

{$$ TKUTMai n} 

{$ELSEC} 

{$$ UTMai n} 

{$ENDC} ; 
Me Lee ee ee ee ee eee ee ee ee eee ee re ee eee eS ee eee ee 
PROCEDURE {TCollection. }ShiftColl(afterSrclndex, afterDstIlndex, howMany: INTEGER); 

Pieintiielecacalmale peatabcc she imate ae wie coat aon, ow nce iat ncns asa nee ance ncaa aa een Rado RNR SMR ace Sin ce ae mona me ela Romine he } 


Apple Lisa ToolKit 3.0 Source Code Listing -- 960 of 1012 


Apple Lisa Computer Technical Information 


000524 VAR member Bytes: INTEGER 

000525 numBytes: INTEGER 

000526 startAddr: LONGI NT; 

000527 srcAddr: LONGI NT; 

000528 dstAddr: LONGI NT; 

000529 BEGIN 

000530 {$lFC fTraceUT} LogCall; {$ENDC} 

000531 1F (howMany > 0) AND (afterSrclndex <> afterDstIndex) THEN 
000532 BEGIN 

000533 memberBytes := SELF. Member Bytes 

000534 numBytes := howMany * memberBytes 

000535 

000536 startAddr := TpLONGINT(SELF)* + SELF. dynStart 

000537 srcAddr := startAddr + afterSrclndex * memberBytes 
000538 dstAddr := startAddr + afterDstI ndex * memberBytes 
000539 

000540 IF afterSrclndex < afterDstIindex THEN 

000541 UTXferRight(Ptr(srcAddr), Ptr(dstAddr), numBytes) 
000542 ELSE 

000543 UTXferLeft(Ptr(srcAddr), Ptr(dstAddr), numBytes) 
000544 END; 

000545 END; 

000546 

000547 

000548 {$1FC WthUObj ect} 

000549 {$$ TKUTMain} 

000550 {$ELSEC} 

000551 {$$ UTMai n} 

000552 {$ENDC} 

000553 Te Lee eer Tey ee ey Te eee ee ee ee ee eee ee eee ee ee 
000554 PROCEDURE {TCollection. }StartEdit( withSlack: INTEGER); 

000555 en ere er rere rr err cert er See ee rere ee ere ee ee ree ee ee ee 
000556 BEGIN 

000557 {$lFC fTraceUT} LogCall; {$ENDC} 

000558 SELF. holeStd := withSlack 

000559 END; 

000560 

000561 

000562 {$l1FC WthUObj ect} 

000563 {$$ TKUTMai n} 

000564 {$ELSEC} 

000565 {$$ UTMai n} 

000566 {$ENDC} 

000567 {iaiecuiaslo cum ecatem cate cea one Sage tea ee sees Surges nea Rapeeaee cea amen wet haa Gu ead eb cdany cighwuaine Sarg 
000568 PROCEDURE {TCollection. }StopEdit; 

000569 oe eet ee eee eee eer ee ee ee ee ee ene eS eee ce ce re 
000570 BEGIN 

000571 {$lFC fTraceUT} LogCall; {$ENDC} 
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000572 
000573 
000574 
000575 
000576 
000577 
000578 
000579 
000580 
000581 
000582 
000583 
000584 
000585 
000586 
000587 
000588 
000589 
000590 
000591 
000592 
000593 
000594 
000595 
000596 
000597 
000598 
000599 
000600 
000601 
000602 
000603 
000604 
000605 
000606 
000607 
000608 
000609 
000610 
000611 
000612 
000613 
000614 
000615 
000616 
000617 
000618 
000619 
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IF SELF. holeStart < SELF.size THEN 
SELF. EditAt(SELF.size + 1, 0) 
SELF. Resi zeColl (SELF. size); 
SELF. holeStd := 0 
SELF. holeSize := 0 
END; 
{$1 FC WithUObj ect } 
{$$ TKUTI nit} 
{$ELSEC} 
{$$ UTI nit} 
{$ENDC} 
END; 
METHODS OF TUTArray; 
{$1 FC WithUObj ect } 
{$$ TKUTMai n} 
{$ELSEC} 
{$$ UTMai n} 
{$ENDC} 

s cdwaGAT ayciees Saydieein ne sai teva cnmse De Caw alas cae ce-tdhdasburte Gaifbes sme lett cateane abe cea ecaseavereccdsecvara ne gicavesgadese a Seedy aad mnie ne Sew kai eee heeded ae } 
FUNCTION {TArray. }CREATE(object: TUTObject; heap: THeap; initialSlack, bytesPerRecord: INTEGER): TUTArray 
BEGIN 

{$1 FC fTraceUT} LogCall; {$ENDC} 
IF ODD( bytesPerRecord) THEN 
bytesPerRecord := bytesPerRecord + 1; 
IF object = NIL THEN 
object := NewDynObject( heap, THISCLASS, initialSlack * bytesPerRecord) 
SELF := TUTArray(TUTCollection. CREATE(object, heap, initial Slack)); 
SELF.recordBytes := bytesPerRecord 
END; 
{$1 FC WithUObj ect } 
{$$ TKUTMai n} 
{$ELSEC} 
{$$ UTMai n} 
{$ENDC} 
near Sere ee gee eee earn eae ee gee ee ee eee ee a eee ee eer ee ee ee ean } 
FUNCTION {TArray.}MemberBytes: INTEGER 
{etctais doen neLnea ed Nena enone nese be es ele Pe ena alte eect eaon en eel tte teat abe dane } 
BEGIN 
{$1 FC fTraceUT} LogCall; {$ENDC} 
MemberBytes := SELF. recordBytes; 
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000620 END; 

000621 

000622 

000623 {$l1FC WthUObj ect} 

000624 {$8 TKUTMai n} 

000625 {$ELSEC} 

000626 {$$ UTMai n} 

000627 {$ENDC} 

000628 nr eee Sn eee ee ee re ee ee ee ee ee eee re ne eee ee eee oe 
000629 FUNCTION {TArray. }At(i: LONGINT): Ptr 

000630 errr tee er ee er re ee eee ee ee ee ee ee eee ee eee eee eee eee sre ee 
000631 BEGIN 

000632 {$lFC fTraceUT} LogCall; {$ENDC} 

000633 { At := Ptr(SELF.AddrMember(i)); but for speed... } 

000634 

000635 IF i > SELF. holeStart THEN 

000636 i :=i + SELF. holeSize 

000637 

000638 At := Ptr(TpLONGINT(SELF)* + SELF. dynStart + (SELF.recordBytes * (i - 1))) 

000639 END; 

000640 

000641 

000642 {$l1FC WthUObj ect} 

000643 {$8 TKUTMai n} 

000644 {$ELSEC} 

000645 {$$ UTMai n} 

000646 {$ENDC} 

000647 ere: terre er er eer rey eer eee renee Ter Tee er ere ee eee eee eee eee ee ey Tee 
000648 PROCEDURE {TArray. }Del All 

000649 Faience singe asl wpe ersusiuiele cutie caceeanale sae a seta ane eeomeat a elena Oui 2 Gleva dare tanita actlaab.celaute acyl Gina yoe eich ymieheetetD egele® 
000650 BEGIN 

000651 {$lFC fTraceUT} LogCall; {$ENDC} 

000652 SELF. EditAt(1, -SELF.size); 

000653 END: 

000654 

000655 

000656 {$l1FC WthUObj ect} 

000657 {$$ TKUTMai n} 

000658 {$ELSEC} 

000659 {$8 UTMai n} 

000660 {$ENDC} 

000661 err errr eet EL Ter eT erie Te ee eer Te ee ee ee rere ee eee eT ee ee ey eee eee eC Cer 
000662 PROCEDURE {TArray. }Del At(i: LONGI NT); 

000663 [eicc tanieeecncinkaieeeealnweehins tains t onGeeesen cases Stee Cum er eee heehee eda ghd et wee ep coeee pee sans 
000664 BEGIN 

000665 {$lFC fTraceUT} LogCall; {$ENDC} 

000666 SELF. EditAt(i, -1); 

000667 END; 
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000668 

000669 

000670 {$l1FC WthUObj ect} 

000671 {$$ TKUTMai n} 

000672 {$ELSEC} 

000673 {$$ UTMai n} 

000674 {$ENDC} 

000675 Pe eee ree ee reer er re ee eer ee eee ee er ee er re 
000676 PROCEDURE {TArray.}Del ManyAt(i, howMany: LONGI NT); 

000677 ee ee ee ee ee re er or err ee ee er See ete ere ere eee ee 
000678 BEGIN 

000679 {$lFC fTraceUT} LogCall; {$ENDC} 

000680 SELF. EditAt(i, -howMany) 

000681 END; 

000682 

000683 

000684 {$1FC WthUObj ect} 

000685 {$$ TKUTMai n} 

000686 {$ELSEC} 

000687 {$$ UTMai n} 

000688 {$ENDC} 

000689 [rateniseetaligusecdimatasineet teat eatide sy dcp dteenh tices teaeielceatinetiee ieee Taek ied ihded ees 
000690 PROCEDURE {TArray.}PutAt(i: LONGINT; pRecord: Ptr) 

000691 fis chcsendnasalavetercrdlctnsw piae ances a ate shan, © gt id ea ci faravnen SW as neel By eCaoncn Siac aiucel eRe cama Min RO BIE AROR wcthe aha aod eae MMe mena eeetiace 
000692 BEGIN 

000693 {$lFC fTraceUT} LogCall; {$ENDC} 

000694 UTXferLeft(pRecord, Ptr(SELF.AddrMember(i)), SELF.recordBytes) 

000695 END; 

000696 

000697 

000698 {$l1FC WthUObj ect} 

000699 {$$ TKUTMai n} 

000700 {$ELSEC} 

000701 {$$ UTMai n} 

000702 {$ENDC} 

000703 ee ee eee ee Cee Ce ee eee er Se ee eT ee ee ee eee ee ee ee 
000704 PROCEDURE {TArray. }Il nsAt(i: LONGINT; pRecord: Ptr) 

000705 {isis cwh amined at enniasea eee cata mnieke oe che tae tenet Cote a a Ree Nee Lah Cte e Aten liet 
000706 BEGIN 

000707 {$lFC fTraceUT} LogCall; {$ENDC} 

000708 SELF. EditAt(i, 1); 

000709 SELF. PutAt(i, pRecord) 

000710 END; 

000711 

000712 

000713 1FC WithUObj ect } 


{$ 
000714 {$$ TKUTMain} 
000715 {$ELSEC} 
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000716 {$$ UTMain} 
000717 {$ENDC} 


000718 ib te eye are ara mn) Sit rn meer Gre peteom Suhre ealerteet a cits Cag a ar ay Mpadkon te, Shear gw chctbeat in oiecatn eine at tata tae agente Seaieec knead 
000719 PROCEDURE {TArray. }Il nsLast(pRecord: Ptr); 

000720 ree ae eae re re er ere eee re ee ere Te ee Tee ere Mer ey eee eee ee 
000721 BEGIN 

000722 {$lFC fTraceUT} LogCall; {$ENDC} 

000723 {$I1FC fTrce}BP( 3); {$ENDC} 

000724 SELF. I nsAt(SELF.size + 1, pRecord) 

000725 {$IFC fTrce}EP; {$ENDC} 

000726 END; 

000727 

000728 

000729 {$l1FC WthUObj ect} 

000730 {$$ TKUTI nit} 

000731 {$ELSEC} 

000732 {$8 UTI nit} 

000733 {$ENDC} 

000734 END; 

000735 

000736 

000737 METHODS OF TUTString 

000738 

000739 {$1FC WthUObj ect} 

000740 {$$ TKUTMai n} 

000741 {$ELSEC} 

000742 {$$ UTMai n} 

000743 {$ENDC} 

000744 Wisco tiane Aime Gina Cm abend para ena Dens Sinaia S tule Suck a Gacieacmurnae alae tical ama.albon es manenmiad e wereiuela aicmeialbleteli as 
000745 FUNCTION {TString. }CREATE(object: TUTObject; heap: THeap; initial Slack: INTEGER): TUTString 

000746 Peer teen een tnee tee Sere eter eer ee ree CE er ee mere re er tee er Cer Te 
000747 BEGIN 

000748 {$lFC fTraceUT} LogCall; {$ENDC} 

000749 IF ODD(initialSlack) THEN 

000750 initialSlack := initialSlack + 1; 

000751 IF object = NIL THEN 

000752 object := NewDynObject( heap, THISCLASS, initial Sl ack); 

000753 SELF := TUTString(TUTColl ection. CREATE(object, heap, initial Slack)); 

000754 END; 

000755 

000756 

000757 {$l1FC WthUObj ect} 

000758 {$$ TKUTMai n} 

000759 {$ELSEC} 

000760 {$$ UTMai n} 

000761 {$ENDC} 

000762 EP ere pee eee eS eee T eR Terre eee Te rey ee eT ee eT YT Ce TET eT eer TE Cer oe eer ere 
000763 FUNCTION {TString. }At(i: LONGINT): CHAR 
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000764 re eee ee eee ere ere eee ee eee eer ere re eee ee ee ere ee ee er 
000765 BEGIN 

000766 {$l FC fTraceUT} LogCall; {$ENDC} 

000767 {At : = CHAR(TPByte(SELF.AddrMember(i))%*); but for speed... } 

000768 

000769 IF i > SELF. holeStart THEN 

000770 i :=i + SELF. holeSize 

000771 At := CHAR(TPByte(TpLONGI NT(SELF)* + SELF. dynStart + (i - 1))%); 

000772 END; 

000773 

000774 

000775 {$l1FC WthUObj ect} 

000776 {$$ TKUTMai n} 

000777 {$ELSEC} 

000778 {$$ UTMai n} 

000779 {$ENDC} 

000780 {soci heseininetiesdtersetieie esi eeetidehtlopetets ting tecutetieaiiiee melee Meds hed eh oeh eles 
000781 PROCEDURE {TString. }Del At(i: LONGI NT) 

000782 ree ee ee ee ee ee ee ne eRe ee re re ee oe a eee ee Ee 
000783 BEGIN 

000784 {$lFC fTraceUT} LogCall; {$ENDC} 

000785 SELF. EditAt(i, -1); 

000786 END; 

000787 

000788 

000789 {$l1FC WthUObj ect} 

000790 {$$ TKUTMai n} 

000791 {$ELSEC} 

000792 {$$ UTMai n} 

000793 {$ENDC} 

000794 ee eee ee Re eee ee Re ee ee Cee ee ee ne eRe eee ee ee re 
000795 PROCEDURE {TString. }Del Al| 

000796 {iret eh semiitadstoaw needa sed eh eee ew ees eee team t ee ele hee ears tee eee eee C 
000797 BEGIN 

000798 {$lFC fTraceUT} LogCall; {$ENDC} 

000799 SELF. EditAt(1, -SELF.size); 

000800 END; 

000801 

000802 

000803 {$l1FC WthUObj ect} 

000804 {$$ TKUTMai n} 

000805 {$ELSEC} 

000806 {$$ UTMai n} 

000807 {$ENDC} 

000808 finda Tau Peewee e ieee tail Gabecainc sel oedted scant aan Ripe ea oa eee git 
000809 PROCEDURE {TString. }Del ManyAt(i, howMany: LONGI NT) 

000810 (suse Ue tw oa sar ee entered oamaa so neueld datos sete Oe eee hae one ou cee Sue sere ecaatecuse 
000811 BEGIN 
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000812 {$lFC fTraceUT} LogCall; {$ENDC} 

000813 SELF. EditAt(i, -howMany) 

000814 END; 

000815 

000816 

000817 {$l1FC WthUObj ect} 

000818 {$$ TKUTMai n} 

000819 {$ELSEC} 

000820 {$$ UTMai n} 

000821 {$ENDC} 

000822 Pareiotele astra ci aiaiee Cinvaleie cad Bec recon lace Beane toaraneee: vier anh eunneenal tiara cual a seesans salem imalele.d aides edits biel pase tome mea wp Aas 
000823 PROCEDURE {TString. }l nsAt(i: LONGINT; character: CHAR); 

000824 eo ee ete er Teer Cre Tere he we eee Pe ee rere eee ee 
000825 VAR pByte: TPByte; 

000826 BEGIN 

000827 {$lFC fTraceUT} LogCall; {$ENDC} 

000828 SELF. EditAt(i, 1); 

000829 

000830 {TPByte(SELF.AddrMember(i))* := PByte(character); but for speed... } 

000831 

000832 pByte := TPByte(TpLONGINT(SELF)* + SELF.dynStart + (i - 1)); 

000833 pByte* := TByte(character); 

000834 END; 

000835 

000836 

000837 {$1FC WthUObj ect} 

000838 {$$ TKUTMai n} 

000839 {$ELSEC} 

000840 {$$ UTMai n} 

000841 {$ENDC} 

000842 fis adie Wate eae ee eee ree Rhea nee eee eee nee ene ecco ete ee a a car eae 
000843 PROCEDURE {TString. }I nsPAOCAt(i: LONGINT; pPackedArrayOfCharacter: Ptr; howMany: LONGI NT); 

000844 {edie cers ecans ease een Sameer neat ence baeene ee kemalw eae ee Sata sacar aaa aetna Cage e ens 
000845 BEGIN 

000846 {$lFC fTraceUT} LogCall; {$ENDC} 

000847 SELF. EditAt(i, howMany) 

000848 UTXferLeft(pPackedArrayOfCharacter, Ptr(SELF.AddrMember(i)), howMany) 

000849 END; 

000850 

000851 

000852 {$l1FC WthUObj ect} 

000853 {$$ TKUTMai n} 

000854 {$ELSEC} 

000855 {$$ UTMai n} 

000856 {$ENDC} 

000857 Me oe ee ee ee ey ee ey re ee eee ee eee eh ee ee re 
000858 PROCEDURE {TString. }ToPAOCAt(i, howMany: LONGINT; pPackedArrayOfCharacter: Ptr); 

000859 Pieintaiestecacal mnie graitiene dha signe aareabenae arnSiya mC otpahasetn bse xara doa et a descea chal eee nf Saaern ase i ta Ra alae ec Bde Oainenha, aCe ha amines 


Apple Lisa ToolKit 3.0 Source Code Listing -- 967 of 1012 


Apple Lisa Computer Technical Information 


000860 BEGIN 

000861 {$I FC fTraceUT} LogCall; {$ENDC} 

000862 SELF. EditAt(i + howMany, 0) 

000863 UTXferLeft(Ptr(SELF.AddrMember(i)), pPackedArrayOfCharacter, howMany) 
000864 END; 

000865 

000866 

000867 {$l1FC WthUObj ect} 

000868 {$$ TKUTMain} 

000869 {$ELSEC} 

000870 {$$ UTMai n} 

000871 {$ENDC} 

000872 ee ee eee ree err er ee ee ee ee ee ee er ere eee eee 
000873 FUNCTION {TString. }Member Bytes: INTEGER 

000874 {rniiee wn htwe etigtee ects epuie ae wee et heen ge «nig Swe ee Oe aiewn wale Dating Glee eget Pies wee saab eee 
000875 BEGIN 

000876 {$lFC fTraceUT} LogCall; {$ENDC} 

000877 MemberBytes := 1; 

000878 END; 

000879 

000880 

000881 {$l1FC WthUObj ect} 

000882 {$$ TKUTI nit} 

000883 {$ELSEC} 

000884 {$$ UTI nit} 

000885 {$ENDC} 

000886 END; 

000887 

000888 {$ENDC} 

000889 

000890 

000891 {$l FC f Universal TextTrace} 

000892 {$l1FC WthUObj ect} 

000893 {$$ TKUTMai n} 

000894 {$ELSEC} 

000895 {$$ UTMai n} 

000896 {$ENDC} 

QO08O7) dette Cie nce eee oi eae te a eee ee ete ven ae eae vee wie S 
000898 PROCEDURE PrintRun; 

QUUG09s Wiereteuitecentie cen sasine cen auls eden scum aeenasenaa Cu aalem ou Posie adlon ae a eadirdlegs majesty stated 
000900 VAR i: INTEGER; 

000901 tab: TTabDescritor 

000902 

000903 BEGIN 

000904 {$lFC fTraceUT} LogCall; {$ENDC} 

000905 {$1 FC fTrce}BP( 11); {$ENDC} 

000906 {I pd, achad} 

000907 WRITELN('the character Descriptor is '); 
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000908 
000909 
000910 
000911 
000912 
000913 
000914 
000915 
000916 
000917 
000918 
000919 
000920 
000921 
000922 
000923 
000924 
000925 
000926 
000927 
000928 
000929 
000930 
000931 
000932 
000933 
000934 
000935 
000936 
000937 
000938 
000939 
000940 
000941 
000942 
000943 
000944 
000945 
000946 
000947 
000948 
000949 
000950 
000951 
000952 
000953 
000954 
000955 
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ey 


FOR i := 1 TO activeStreamdata.size DO 
WRITE(activeStream. data. At(i)); 
WRI TELN; 
WRI TELN(' maxDataSize ', activeStream. maxDataSi ze) 
WTH activeStreamcharacterDescriptor DO 
BEGIN 
WRI TELN(' font ', font); 
WRI TELN(' face '); 
WRI TELN(' Superscript ', Superscript); 
WRI TELN(' keepOnSamePage ', keepOnSamePage) 
END; 


WRITELN('the paragraph Descriptor is '); 
WTH activeStream paragraphDescriptor DO 


BEGIN 
WRI TELN(' paraGraphStart ', paraGraphStart); 
WRI TELN(' firstLineMargin ', firstLineMargin) 
WRI TELN(' bodyMargin ', bodyMargin) 
WRI TELN(' rightMargin ', right Margin) 
WRI TELN(' paraLeading ', paraLeading) 
WRI TELN(' lineSpacing ', lineSpacing); 
WRI TELN(' ', tabTable.size:2,' Tabs ') 
FOR i := 1 TO tabTable.size DO 
BEGIN 
tab := TTabDescritor(tabTable. At(i)); 
WITH tab DO 
BEGIN 
WRI TELN(' position ', position); 
WRITE (' fill BetweenTabs '); 
CASE fill BetweenTabs OF 
tNoFill: WRITELN('No fill'); 
tDot Fill: WRITELN('Dot fill'); 
tHyphenFill: WRI TELN('Hyphen fill'); 
tUnderLineFill: WRITELN(' Underline fill'); 
END; {CASE} 
WRITE (' tabType |); 
CASE tabType OF 
qleftTab: WRI TELN('Left tab'); 
qCenterTab: WRI TELN('Center tab'); 
qRi ght Tab: WRITELN(' Right tab'); 
qPeri odTab: WRI TELN(' Decimal period tab'); 
qCommaTab: WRI TELN(' Decimal comma tab'); 
END; {CASE} 
END; 
END; 
WRITE (' paratype '); 


CASE paraType OF 
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000956 qLeftPara: WRITELN('Left aligned'); 
000957 qCenter Para: WRI TELN(' Centered’ ) 
000958 qRi ght Para: WRITELN(' Right aligned'); 
000959 qj ust Para: WRI TELN('Justified' ) 
000960 END; {CASE} 

000961 WRI TELN(' hasPicture ', hasPicture) 
000962 END; 

000963 {$H+} 

000964 {$1 FC fTrce}EP; {$ENDC} 


000965 END; 
000966 {$ENDC} 


000967 

000968 

000969 {$l FC f Universal TextTrace} 

000970 {$1FC WthUObj ect} 

000971 {$8 TKUTMai n} 

000972 {$ELSEC} 

000973 {$$ UTMai n} 

000974 {$ENDC} 

a Ce er ee ee rer err Perce nero enc rec ec e  c e er eee ere eer eer cc 
000976 PROCEDURE PrintLpd(theLpd: TALpd); 

Q009TT Neate icekietomeieen eee esse tena enh ieGideltecedser tice tice atiantemiagleseite ethene hikes 
000978 

000979 PROCEDURE WriteQuad( quad: TQuad) 

000980 BEGIN 

000981 {$lFC fTraceUT} LogCall; {$ENDC} 

000982 CASE quad OF 

000983 quadL: WRITELN(' quadL') 

000984 quadC: WRITELN(' quadC' ) 

000985 quadR: WRITELN(' quadR' ) 

000986 quadj: WRITELN('quadj'); 

000987 END; 

000988 END: 

000989 

000990 PROCEDURE WriteTArpe(arpe: TArpe) 

000991 VAR i: INTEGER 

000992 BEGIN 

000993 {$lFC fTraceUT} LogCall; {$ENDC} 

000994 WITH arpe DO 

000995 BEGIN 

000996 WRI TELN(' cb: ', cb: 1) 
000997 WRI TELN(' sy: ', sy:l) 
000998 WRI TELN(' XLftFst: ', xlftFst:1) 
000999 WRI TELN(' XLft Body: ', XxLftBody: 1) 
001000 WRI TELN(' XRt: ', xRt:1) 
001001 WRI TELN(' yld: ', yld: 1) 
001002 WRI TELN(' fill: ', fillds1); 
001003 WRI TELN(' yLine: ', yline:1); 
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001004 
001005 
001006 
001007 
001008 
001009 
001010 
001011 
001012 
001013 
001014 
001015 
001016 
001017 
001018 
001019 
001020 
001021 
001022 
001023 
001024 
001025 
001026 
001027 
001028 
001029 
001030 
001031 
001032 
001033 
001034 
001035 
001036 
001037 
001038 
001039 
001040 
001041 
001042 
001043 
001044 
001045 
001046 
001047 
001048 
001049 
001050 
001051 
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Information 


WRITE (' quad: '); 
Wri teQuad( quad); 
WRI TELN(' itbLim ', itblLimd); 
WRI TELN(' argtbd:'); 
FOR i := 0 TO itblLim- DO 
{$R- } 
WITH argtbd[i] DO 
BEGIN 
WRI TELN(' [',i:0,']:'); 
WRI TELN(' X! ', xl); 
(* WRITELN(' fill4: ', fill4:1); *) 
WRITE (' quad: '); 
WriteQuad(argtbd[i]. quad); 
WRITE (' tyfill: oe eH 
CASE tyfill OF 
tyfill Nil: WRITELN('tyfill Nil'); 
tyfill Dots: WRITELN('tyfill Dots'); 
tyfill Hyph: WRITELN('tyfill Hyph'); 
tyfill UL: WRITELN('tyfillUL'); 
END; 
WRI TELN(' chLdr: ', chldr:1); 
END; 
{$R+} 
END; 
END; 
BEGIN 
{$1 FC fTraceUT} LogCall; {$ENDC} 
{$1 FC fTrce}BP( 11); {$ENDC} 
WRI TELN(' --—--- Lpd ---—-- a he 
WTH theLpd DO 
BEGIN 
WRITELN('ics: ', desi1); 
WRITELN('i | pd: ', ilpd:1); 
WRI TELN('f ParSt: ', fParSt); 
WRI TELN('I p: ', [p:l); 
WRITELN('I plim ', -plim=1); 
WRITELN('I pson: ', [pson:1); 
WRITELN('icsson: ', desson:1); 


WRITELN('tyset:'); 
WITH tyset DO 


BEGIN 
WRI TELN(' f Rce: 
WRI TELN(' f ParBnds: 
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001052 WRI TELN(' f Rpe: ', tyset. fRpe); 
001053 END; 

001054 WRI TELN('| pFstPar: ', [pFstPar:1); 

001055 WRI TELN('| pLi mPar: ', [pLimPar:1); 

001056 

001057 IF tyset.fRpe THEN 

001058 1F rpe = NIL THEN 

001059 WRI TELN('rpe: NIL') 

001060 ELSE 

001061 WITH rpe* DO 

001062 BEGIN 

001063 WRITELN('rpe:'); 

001064 WriteTArpe(rpe*); 

001065 END; 

001066 

001067 IF tyset.fRce THEN 

001068 WITH arce DO 

001069 BEGIN 

001070 WRITELN('arce:'); 

001071 WRI TELN(' cb: ', chil); 
001072 WRI TELN(' f Van: ', fVan:1); 
001073 WRI TELN(' f Bol d: ', fBold:1); 
001074 WRI TELN(' fltalic: ', fltalic:1); 
001075 WRI TELN(' f Underline: ', fUnderline:1); 
001076 WRI TELN(' fill 4: ', fill4:1); 
001077 WRI TELN(' chSuperscript: ', chSuperscript:1); 
001078 WRI TELN(' ifnt: ', ifnt:1); 
001079 WRI TELN(' f Keep: ', f Keep: 1); 
001080 WRI TELN(' f Out Line: ', fOutLine:1); 
001081 WRI TELN(' f Shadow: ', f Shadow: 1); 
001082 WRI TELN(' f Fil lB: ', fFillB:1); 
001083 WRI TELN(' f Fill: ', fFillC:1); 
001084 WRI TELN(' f Fill D: ', fFillD:1); 
001085 WRI TELN(' f Fille: ‘| fFillE:1); 
001086 WRI TELN(' f Fill F: ', fFillF:1); 
001087 END; 

001088 

001089 IF tyset.fRpe THEN 

001090 BEGIN 

001091 WRITELN('arpe:'); 

001092 WriteTArpe(arpe); 

001093 END; 

001094 

001095 END; 

001096 

001097 WRI TELN(' ---—-----------—--- ‘); 

001098 WRI TELN; 

001099 {$1 FC fTrce}EP; {$ENDC} 
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001100 END; 
001101 {$ENDC} 


001102 

001103 

001104 

001105 

001106 {$lFC f Universal TextTrace} 

001107 {$l1FC WthUObj ect} 

001108 {$$ TKUTMain} 

001109 {$ELSEC} 

001110 {$8 UTMai n} 

001111 {$ENDC} 

VS Gay es ene eee ne ee a etc eee er ee ee nee tec ee eee ee eee eee 
001113 PROCEDURE PrintAchad(achad: TAchad) 

0) ee Coens ee ee ee ee ee ee eee 
001115 VAR i: | NTEGER 

001116 size: INTEGER 

001117 

001118 BEGIN 

001119 {$lFC fTraceUT} LogCall; {$ENDC} 
001120 {$I FC fTrce}BP( 11); {$ENDC} 

001121 WTH achad DO 

001122 BEGIN 

001123 WRI TELN(' ----—- Achad ----—— ') 

001124 WRITELN('ichFst: ', ichFst: 1) 
001125 WRITELN('ichLim: ', ichlim 1) 
001126 IF rgch <> NIL THEN 

001127 BEGIN 

001128 size := ichlim- ichFst - 1: 
001129 IF size >= 80 THEN 

001130 size := 79; 

001131 FOR i := ichFst TO ichFst + size DO 
001132 {$R- } 

001133 IF rgch*[i] >= 32 THEN 
001134 WRI TE( CHR(rgch*[i])) 
001135 ELSE 

001136 WRITE('<', rgch*[i]:0, '>'); 
001137 {$R+} 

001138 WRI TELN 

001139 IF ichlim- ichFst >= 79 THEN 
001140 WRITELN(' etc, etc...'); 
001141 END; 

001142 WRI TELN(' -—-----------—----—— ') 

001143 WRI TELN 

001144 END; 

001145 {$I FC fTrce}EP; {$ENDC} 


001146 END; 
001147 {$ENDC} 
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001148 

001149 

001150 

001151 

001152 {$lFC f Universal TextTrace} 

001153 {$l1FC WthUObj ect} 

001154 {$$ TKUTMai n} 

001155 {$ELSEC} 

001156 {$$ UTMai n} 

001157 {$ENDC} 

i? cc etree weer er ere tern eee Tre ke er eT er ee eee eee eer er ey eee eer 
001159 PROCEDURE PrintSecrets(achad: TAchad; theLpd: TALpd); 

het) i Cee er eee rr eT er rere ne oer ee ere eer cre eer ere ect een cr 
001161 BEGIN 

001162 {$lFC fTraceUT} LogCall; {$ENDC} 

001163 {$I FC fTrce}BP( 11); {$ENDC} 

001164 WRITELN('streamArrayl ndex is ', secrets.streamArrayl ndex) 

001165 PrintLpd(theLpd); 

001166 PrintAchad(achad); 

001167 {$I FC fTrce}EP; {$ENDC} 


001168 END; 
001169 {$ENDC} 


001170 

001171 

001172 {$l1FC WthUObj ect} 

001173 {$$ TKUTWrite} 

001174 {$ELSEC} 

001175 {$8 UTWrite} 

001176 {$ENDC} 

tte oe ee ee ee ee ee ee eee ee ee eee 
001178 PROCEDURE SeqLpdUTBB(Lpd: TLpd; var achad: Tachad); 

QOTT79 fees oct ee Ak teins Vie ee hw erie a eter g ape wide bw ieiacdinierale: aie ge hig! Rie Siggy otcigieig ead aad Gane oree a ieee eR etn oa eta 
001180 VAR howMany: INTEGER 

001181 done: BOOLEAN 

001182 index: INTEGER 

001183 backUp: INTEGER 

001184 newPara: BOOLEAN 

001185 {$l1FC WthUObj ect} 

001186 newData: TString; 

001187 {$ELSEC} 

001188 newData: TUTString 


001189 {$ENDC} 
001190 BEGIN 


001191 {$lFC fTraceUT} LogCall; {$ENDC} 

001192 {$1 FC fTrce}BP( 11); {$ENDC} 

001193 

001194 {LSR: put the next assignment and the WITH before the debugging code because 
001195 PrintSecrets depends on it. } 
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001196 
001197 
001198 
001199 
001200 
001201 
001202 
001203 
001204 
001205 
001206 
001207 
001208 
001209 
001210 
001211 
001212 
001213 
001214 
001215 
001216 
001217 
001218 
001219 
001220 
001221 
001222 
001223 
001224 
001225 
001226 
001227 
001228 
001229 
001230 
001231 
001232 
001233 
001234 
001235 
001236 
001237 
001238 
001239 
001240 
001241 
001242 
001243 
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currentLpd := I pd; { Remember the Ipd for RunToStream } 
WTH I pd* DO { Make shure the Ipd is set up OK } 
BEGIN 
rpe := @arpe; 
rece := @arce; 
END; 


{$1 FC fUniversal Text Trace} 
IF fPrintSecrets THEN 
BEGIN 
WRI TELN( ' -----------------------—------ SeqLpdUTBB —---------------------—------ "yy 
PrintSecrets(achad, currentLpd%); 
WRITELN('dataLp = ', dataLp: 0) 
WRITELN('datalndex = ', datalndex:0); 
WRITELN('nOfSavedPara = ', nOfSavedPara: 0) 
END; 
{$ENDC} 


newPara := FALSE; {Assume no new para} 
{ Compute if we have to back up } 
backUp := MIN(maxBacking, MAX(dataLp - Ipd*.IpLim, 0)); 


{$1 FC fUniversal Text Trace} 
IF fPrintSecrets THEN 


WRITELN('backUp = ', backUp: 0) 
{$ENDC} 
IF backUp > 0 THEN 

BEGIN 

index := 1; 

done := FALSE: 


WHILE (NOT done) AND (index <= nOfSavedPara) DO 
WITH savedPara[index]**, I pd* DO 

IF firstLp <= | pLim THEN 
BEGIN 
{$1 FC f Universal TextTrace} 
IF fPrintSecrets THEN 

WRI TELN(' Backing up... to saved paragraph #', index: 0) 

{$ENDC} 


|plLim:= MAX(firstLp, | pLim) 
theData := theText; 
datalndex := IpLim~ firstLp; 
arpe := theArpe 
I1F datalndex <> 0 THEN 

fParSt := FALSE; 
arce := theArce 
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001244 done := TRUE; 

001245 END 

001246 ELSE 

001247 index := index + 1; 

001248 

001249 1F NOT done THEN { This is FATAL !!!} 

001250 BEGIN 

001251 {$1 FC f Universal TextTrace} 

001252 WRITELN('Fatal back up attempt in SeqLpdUTBB' ); 

001253 PrintSecrets(achad, | pd*) 

001254 {$ENDC} 

001255 

001256 HALT; {Die rather than fuck up} 

001257 END; 

001258 END 

001259 ELSE 

001260 BEGIN 

001261 IF activeStream data. Size = 0 THEN { Test if there is anything left in the buffer, } 
001262 BEGIN 

001263 newPara := TRUE; 

001264 activeStream ParagraphDescriptor. paraGraphStart := TRUE; 

001265 {$lFC WithUObj ect} 

001266 activeStream ParagraphDescriptor. additional ChrinParagraph := 0 

001267 {$ENDC} 

001268 activeStream Fill Paragraph; { if not then try to get one more paragraph } 
001269 activeStream data. StopEdit; { Remove any holes from data } 
001270 

001271 {$1 FC fUniversal TextTrace} 

001272 [F fPrintSecrets THEN 

001273 BEGIN 

001274 WRI TELN('Fill Run returns:'); 

001275 Print Run; 

001276 END; 

001277 {$ENDC} 

001278 

001279 datalndex := 0; { Reset the index to the begining of the text} 
001280 

001281 WITH I pd* DO { Pre-fill the I pd with standard data } 
001282 BEGIN 

001283 {$H-} MoveRgch(@arpe, @arpeStd, arpeStd.cbh); {$H+} 

001284 {$H-} MoveRgch(@arce, @arceStd, arceStd.cbh); {$H+} 

001285 dataLp := I pLim 

001286 END; 

001287 

001288 activeStream RunToStream; { Convert into stream format } 
001289 END 

001290 ELSE 

001291 BEGIN 
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001292 {$1 FC fUniversal TextTrace} 

001293 IF fPrintSecrets THEN 

001294 WRITELN('Procede with the rest of the old run:') 

001295 {$ENDC} 

001296 datalndex := Lpd*.IplLim- dataLp; 

001297 IF datalndex <> 0 THEN 

001298 |pd*.fParSt := FALSE; 

001299 END; 

001300 

001301 theData := activeStream data: 

001302 END; 

001303 

001304 

001305 { Compute how many bytes to transfer this time } 
001306 howMany := MIN(achad.ichLim- achad.ichFst, theData.size - datal ndex) 
001307 

001308 {$1 FC fUniversal Text Trace} 

001309 IF fPrintSecrets THEN 

001310 BEGIN 

001311 WRITELN('theData.size = ', theData.size: 0) 

001312 WRITELN('dataLp = ', dataLp: 0) 

001313 WRITELN('datalndex = ', datalndex: 0) 

001314 WRITELN(' howMany = ', howMany: 0) 

001315 WRITELN('newPara = ', newPara: 0) 

001316 END; 

001317 {$ENDC} 

001318 

001319 WTH I pd* DO 

001320 BEGIN 

001321 Ip := I plim 

001322 Iplim:= 1p + howMany; 

001323 END; 

001324 

001325 WTH secrets. achad DO { Build our own achad just in case... } 
001326 BEGIN 

001327 rgch := POINTER( ORD4(theData. AddrMember(1)) + datal ndex) 

001328 ichfst := 0; 

001329 ichLim:= howMany; 

001330 END; 

001331 { Copy the achad } 
001332 { Check for NIL rgch. } 
001333 { If NIL then pass data else copy the data } 
001334 IF achad.rgch = NIL THEN 

001335 achad := secrets. achad 

001336 ELSE 

001337 BEGIN 

001338 achad.ichlim:= achad.ichFst + howMany 

001339 MoveAchad(achad, secrets. achad) 
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001340 END; 

001341 

001342 1F howMany = 0 THEN { We are done, kill all saved stuff } 

001343 FOR index := 1 TO nOfSavedPara DO 

001344 BEGIN 

001345 savedPara[index] **. theText. Free 

001346 FreeH( HzFromH( TH(savedPara[index])), TH(savedPara[index])) 

001347 END 

001348 ELSE 

001349 BEGIN 

001350 1F newPara THEN { New text in activeStreamdata... } 

001351 BEGIN 

001352 done := FALSE; 

001353 index := nOfSavedPara: 

001354 WHILE (NOT done) AND (index > 0) DO { Get ridd of old stuff } 

001355 WITH savedPara[index]** DO 

001356 IF (I pd*.]plLim- (firstLp + theText.size) ) >= maxBacking THEN {LSR} 

001357 BEGIN 

001358 theText. Free; 

001359 FreeH( HzFromH( TH(savedPara[index])), TH(savedPara[index])); 

001360 index := index - 1; 

001361 nOfSavedPara := nOfSavedPara - 1; 

001362 END 

001363 ELSE 

001364 done := true 

001365 

001366 {LSR: changed direction of following | oop} 

001367 FOR index := nOfSavedPara DOWNTO 1 DO { Shift everything to free the first one } 
001368 savedPara[index + 1] := savedParal[i ndex] 

001369 

001370 nOfSavedPara := nOfSavedPara + 1; 

001371 

001372 { Make a new place to save old paragraphs } 
001373 savedPara[1] := POINTER(HAIl ocate(THz(activeStream Heap), SI ZEOF(TSavedPara))); 

001374 WITH savedPara[1]**, Ipd* DO 

001375 BEGIN 
001376 firstLp : 
001377 theArpe 
001378 theArce : 
001379 theText : 
001380 END; 
001381 END; 

001382 

001383 IF (datalndex + howMany) >= activeStream data. Size THEN 

001384 BEGIN { Make a fresh string, the old one is in savedPara[1] } 
001385 

001386 {LSR: break up the assignment to activeStreamdata to prevent dereferenced handles} 
001387 {$l1FC WthUObj ect} 


|p; 

arpe; 

arce} 
activeStream. data; 
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001388 newData := TString. CREATE(NIL, activeStream heap, activeStream maxDataSi ze); 
001389 {$ELSEC} 

001390 newData := TUTString. CREATE(NIL, activeStreamheap, activeStream maxDataSi ze) 
001391 {$ENDC} 

001392 activeStream data := newData; 

001393 activeStream data. StartEdit(50); {Allow holes} 

001394 dataLp := Ipd*. I pLim; {Make shure backUp will compute to zero} 
001395 END; 

001396 END; 

001397 

001398 {$1 FC fUniversal Text Trace} 

001399 IF fPrintSecrets THEN 

001400 BEGIN 

001401 PrintSecrets(achad, currentLpd%); 

001402 WRITELN('dataLp = ', dataLp: 0) 

001403 WRITELN('datalndex = ', datalndex: 0) 

001404 WRITELN('nOfSavedPara = ', nOfSavedPara: 0) 

001405 WRI TELN(' ----------------—------—------------_----_-___----___----—_---—-——---- "ys 
001406 WRI TELN 

001407 WRI TELN 

001408 END; 

001409 {$ENDC} 

001410 

001411 {$I FC fTrce}EP; {$ENDC} 

001412 END: 

001413 

001414 


001415 {$1FC WthUObj ect} 
001416 METHODS OF TTKUnivText 
001417 {$ELSEC} 

001418 METHODS OF TUnivText 
001419 {$ENDC} 

001420 

001421 {$1FC WthUObj ect} 
001422 {$8 TKUTMai n} 

001423 {$ELSEC} 

001424 {$S UTMai n} 

001425 {$ENDC} 


001426 eee eet ee eet ere ere eee ee eee ee ere ee ee ee eee eee eee ee eee 
001427 {$lFC WithUObj ect} 

001428 FUNCTION {TUnivText. }CREATE(object: TObject; 

001429 itsHeap: THeap; 

001430 itsTString: TString; 

001431 itsDataSize: I NTEGER) 

001432 : TTKUnivText; 

001433 {$ELSEC} 

001434 FUNCTION {TUnivText. }CREATE( object: TUTObject; 

001435 itsHeap: THeap; 
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001436 itsTString: TUTString 

001437 itsDataSize: I NTEGER) 

001438 : TUnivText; 
001439 {$ENDC} 

001440 ee ee ere eee eee ere ee Cee Ce ee er ee ee ee ee eee ee ere 
001441 

001442 {$I1FC WithUObj ect} 

001443 VAR thisTabTable: TArray 

001444 {$ELSEC} 

001445 VAR thisTabTable: TUTArray; 

001446 {$ENDC} 

001447 thisString: “TSp; 

001448 

001449 BEGIN 

001450 {$lFC fTraceUT} LogCall; {$ENDC} 

001451 {$I FC fTrce}BP( 11); {$ENDC} 

001452 IF object = NIL THEN 

001453 {$l1FC WthUObj ect} 

001454 object := NewObject(itsHeap, THISCLASS) 

001455 {$ELSEC} 

001456 object := NewUTObject(itsHeap, THISCLASS); 

001457 {$ENDC} 

001458 

001459 {$1FC WthUObj ect} 

001460 SELF := TTKUnivText(obj ect); 

001461 {$ELSEC} 

001462 SELF := TUnivText(obj ect); 

001463 {$ENDC} 

001464 

001465 { Get the stream } 

001466 

001467 SELF.itsOurTString := itsTString = NIL; 

001468 [F SELF.itsOurTString THEN 

001469 {$lFC WithUObj ect} 

001470 itsTString := TString.CREATE(NIL, itsHeap, itsDataSi ze) 
001471 {$ELSEC} 

001472 itsTString := TUTString. CREATE( NIL, itsHeap, itsDataSize); 
001473 {$ENDC} 

001474 

001475 itsTString. StartEdit(50); {Allow hol es} 
001476 SELF.data := itsTString 

001477 SELF. maxDataSize := itsDataSize 

001478 

001479 {$l1FC WthUObj ect} 

001480 thisTabTable := TArray. CREATE(NIL, itsHeap, 0, SIZEOF(TTabDescriptor)); 
001481 {$ELSEC} 

001482 thisTabTable := TUTArray. CREATE(NIL, itsHeap, 0, SIZEOF(TTabDescriptor)); 


001483 {$ENDC} 
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001484 thisTabTable. StartEdit(5) 

001485 SELF. paragraphDescriptor.tabTable := thisTabTabl e; 

001486 {$IFC fTrce}EP; {$ENDC} 

001487 END; 

001488 

001489 

001490 {$l1FC WthUObj ect} 

001491 {$$ TKUTMai n} 

001492 {$ELSEC} 

001493 {$$ UTMai n} 

001494 {$ENDC} 

001495 (rscanm seers cant eadhesacines tabs tive ide lh tieue theese ddan teagielceaiemat igen eek ihedctidek ves 
001496 PROCEDURE {TUnivText. }Free 

001497 {Giada e tunics ean eta tie iota tay ied seceen whew tbeepebewtateetatinietl etree eed ore e eats 
001498 BEGIN 

001499 {$lFC fTraceUT} LogCall; {$ENDC} 

001500 {$I FC fTrce}BP( 11); {$ENDC} 

001501 {lf the dynamic array was not passed in then free it} 

001502 [F SELF.itsOurTString THEN 

001503 SELF. data. Free; 

001504 SELF. paragraphDescriptor.tabTable. Free 

001505 SUPERSELF. Free 

001506 {$IFC fTrce}EP; {$ENDC} 

001507 END; 

001508 

001509 

001510 {$1 FC fDebugMet hods} 

001511 {$1FC WthUObj ect} 

001512 {$8 TKUTMai n} 

001513 {$ELSEC} 

001514 {$$ UTMai n} 

001515 {$ENDC} 

001516 eee ee See Ce er ee ee ee ee ee rere re eee ee Tee eee ea ee 
001517 PROCEDURE {TUnivText. }Fields( PROCEDURE Field(nameAndType: $255) ) 
001518 Se er ee eer rr ee er re ee ee ee ee ree rer ere eke ee eee 
001519 BEGIN 

001520 {$lFC fTraceUT} LogCall; {$ENDC} 

001521 SUPERSELF. Fi el ds( Fi el d) 

001522 Field('paraGraphStart: BOOLEAN'); 

001523 {$l1FC WthUObj ect} 

001524 Field(' additional ChrinParagraph: INTEGER' ); 

001525 {$ENDC} 

001526 Field('firstLineMargin: INTEGER') 

001527 Field('bodyMargin: INTEGER'); 

001528 Field('rightMargin: I NTEGER') 

001529 Field('paraLeading: INTEGER’) 

001530 Field('lineSpacing: BYTE'); 


001531 {$1FC WthUObj ect} 
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001532 Field('tabTable: TArray'); 

001533 {$ELSEC} 

001534 Field('tabTable: TUTArray') 

001535 {$ENDC} 

001536 Field('paraType: BYTE'); 

001537 Field('hasPicture: BOOLEAN'); 

001538 Field('font: INTEGER'); 

001539 Field('face: BYTE'); 

001540 Field('superscript: BYTE'); 

001541 Field('keepOnSamePage: BOOLEAN' ); 
001542 Field('maxDataSize: INTEGER’) 

001543 {$1FC WthUObj ect} 

001544 Field('data: TString'); 

001545 {$ELSEC} 

001546 Field('data: TUTString'); 

001547 {$ENDC} 

001548 Field('itsOurTString: BOOLEAN’ ) 

001549 Field(''); 

001550 END: 

001551 {$ENDC} 

001552 

001553 

001554 {$l1FC WthUObj ect} 

001555 {$8 TKUTWrite} 

001556 {$ELSEC} 

001557 {$8 UTWrite} 

001558 {$ENDC} 

001559 Meri rere errr eee te eer er reer rT Ree eT ere ree Te eee Ee eR eee eee eee ry er er Ten 
001560 PROCEDURE {TUnivText. }RunToStream 

001561 Pisce asta asia gta Samual a eneaie me meet ane cyoRT Blea et Ou. clon due tanbinalemamtloadcselaedtode sare acatyaennieuls one 
001562 VAR i: INTEGER 

001563 found: BOOLEAN 

001564 

001565 BEGIN 

001566 {$lFC fTraceUT} LogCall; {$ENDC} 

001567 {$1 FC fTrce}BP( 11); {$ENDC} 

001568 

001569 IF currentLpd*.tyset.fRce THEN 

001570 { Convert the character descriptor } 
001571 WITH SELF.characterDescriptor, currentLpd*.rce* DO 
001572 BEGIN 

001573 

001574 { Set the face fields } 

001575 fbhold = bold IN face; 
001576 fitalic = italic IN face: 
001577 funderline = underline IN face 
001578 foutline = outline IN face: 
001579 f shadow = shadow IN face 
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001580 

001581 fvan := FALSE: {No vanished runs} 

001582 

001583 { Because of the way lotus does fonts we have to convert the a real font to a lotus font } 


001584 found := FALSE; 


001585 i := 0; 

001586 WHILE (i <= ifntlst) AND NOT(found) DO 
001587 BEGIN 

001588 IF argfam[i] = font THEN 
001589 BEGIN 

001590 ifnt := i: 

001591 found := TRUE: 

001592 END; 

001593 presi +4; 

001594 END; 

001595 [F NOT found THEN ifnt := 0; 

001596 

001597 chSuperscript := superscript; 
001598 fKeep := keepOnSamePage; 

001599 END; { with } 

001600 

001601 { Convert the paragraph descriptor } 

001602 WITH SELF. ParagraphDescriptor, currentLpd*, rpe* DO 
001603 BEGIN 

001604 fParSt := paraGraphStart; 

001605 [F paraGraphStart THEN 

001606 BEGIN 

001607 {LSR: added IpLimto the right side of each of the following assignments} 
001608 [pFstPar := | pLim; 

001609 {$l FC WthUObj ect} 

001610 [plLimPar := |pLim + SELF. data.Size + additional Chri nParagraph; 
001611 {$ELSEC} 

001612 [plLimPar := |pLim + SELF. data. Size; 
001613 {$ENDC} 

001614 END; 

001615 

001616 IF tyset.fRpe THEN 

001617 BEGIN 

001618 XLftFst := firstLineMargin; 

001619 xLftBody := bodyMargin; 

001620 xXRt := rightMargin; 

001621 yLd := paraLeadi ng; 

001622 yLine := lineSpacing; 

001623 

001624 CASE paraType OF 

001625 qLeftPara: quad := quadL; 
001626 qCenterPara: quad := quadC; 
001627 qRi ght Para: quad := quadR; 
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001628 qj ust Para: quad := quad); 

001629 OTHERW SE quad := quadL; 

001630 END; {CASE} 

001631 

001632 itbLim:= tabTable.Size - 1; 

001633 {$H-} SELF. TabTableToArgTbhd; {$H+} { This invalidates WMTH statement!! } 
001634 END; 

001635 END; 

001636 

001637 {$IFC fTrce}EP; {$ENDC} 

001638 END; 

001639 

001640 

001641 {$l1FC WthUObj ect} 

001642 {$8 TKUTMain} 

001643 {$ELSEC} 

001644 {$$ UTMai n} 

001645 {$ENDC} 

001646 eee ee eee eee ee ee ee eee ee ee Een eer eas ee eT eee 
001647 PROCEDURE {TUnivText. }StreamToRun: 

001648 f coisas eer nels ha Setar eater oe eee ate a oe ni oe ina tire alae ee Uo ee a aaa ee 
001649 VAR ifnt: INTEGER 

001650 BEGIN 

001651 {$lFC fTraceUT} LogCall; {$ENDC} 

001652 {$1FC fTrce}BP( 11); {$ENDC} 

001653 { do the format stuff } 

001654 IF secrets.I pd.tyset.frce THEN 

001655 WITH SELF.characterDescriptor, secrets.Ipd.rce* DO 
001656 BEGIN 

001657 font := argfamlifnt]; 

001658 face := []; 

001659 1F fbold THEN 

001660 face := face + [bold] 

001661 IF fitalic THEN 

001662 face := face + [italic]; 

001663 IF funderline THEN 

001664 face := face + [underline] 

001665 IF foutline THEN 

001666 face := face + [outline] 

001667 IF fshadow THEN 

001668 face := face + [shadow] 

001669 Superscript := cbhSuperscri pt; 

001670 keepOnSamePage := fKeep; 

001671 END; 

001672 

001673 IF secrets. I pd.tyset.frpe THEN 

001674 BEGIN 

001675 WITH SELF. paragraphDescriptor, secrets.Ipd.rpe* DO 
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001676 BEGIN 

001677 paraGraphStart := secrets. I pd.fParSt 

001678 firstLineMargin := xLftFst; 

001679 bodyMargin := xLftBody; 

001680 rightMargin := xRt 

001681 paraLeading := yld 

001682 lineSpacing := yLine 

001683 hasPicture := FALSE; {not yet impl emented} 

001684 

001685 CASE quad OF 

001686 quadL: paraType := qLeftPara; 

001687 quadC: paraType := qCenter Para; 

001688 quadR: paraType := qRight Para; 

001689 quad]: paraType := qjust Para; 

001690 OTHERWISE paraType := qLeftPara; 

001691 END; {CASE} 

001692 

001693 IF itbLim < 0 THEN { Resize the tab table and move the data } 
001694 itbLim:= -1; 

001695 END; 

001696 

001697 SELF. ArgTbdToTabTabl e; 

001698 END; 

001699 {$IFC fTrce}EP; {$ENDC} 

001700 END; 

001701 

001702 

001703 {$lFC WthUObj ect} 

001704 {$8 TKUTWrite} 

001705 {$ELSEC} 

001706 {$S UTWrite} 

001707 {$ENDC} 

001708 fin ie SP ayale ete een Aaa ace Moeieerdrele ee aa Tine glee e ERS ARE a eae oes Teel Cale eS 
001709 PROCEDURE {TUnivText. }TabTabl eToArgThd 

001710 fairey talaga a tape atthas ach cratevaen tae ene igh ita (asate fet onegave a) heal anata O10 (21 keulata.cheeE%Rsa alae pa ch axefetataiatelapete amvanste aielets caievetecttacutlace/oe 
001711 VAR i: INTEGER 

001712 temp: INTEGER; 

001713 ptrToTab: Ptr; 

001714 tab: TTabDescri ptor; 

001715 

001716 BEGIN 

001717 ={$lFC fTraceUT} LogCall; {$ENDC} 

001718 {$I1FC fTrce}BP( 11); {$ENDC} 

001719 temp := MIN(SELF. paragraphDescriptor.tabTable.size, magicTabMax) 
001720 FOR i:= 1 to temp DO 

001721 BEGIN 

001722 tab := TTabDescriptor(SELF. paragraphDescriptor.tabTable. At(i)) 
001723 {R$-} 
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001724 
001725 
001726 
001727 
001728 
001729 
001730 
001731 
001732 
001733 
001734 
001735 
001736 
001737 
001738 
001739 
001740 
001741 
001742 
001743 
001744 
001745 
001746 
001747 
001748 
001749 
001750 
001751 
001752 
001753 
001754 
001755 
001756 
001757 
001758 
001759 
001760 
001761 
001762 
001763 
001764 
001765 
001766 
001767 
001768 
001769 
001770 
001771 
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WITH tab, currentLpd*.rpe*.argTbd[i-1] DO 
BEGIN 
X := position; 


CASE tabType OF 
qLeftTab: 
quad := quadL; 
qCenterTab: 
quad := quadC 
qRi ght Tab: 
quad := quadR 
qPeri odTab: 
BEGIN 
quad := quad); 
f Deci mal Comma : = FALSE; 
END; 
qCommaTab: 
BEGIN 
quad := quad]; 
f Deci mal Comma : = TRUE; 
END; 
OTHERW SE 
quad := quadL; 
END; {CASE} 


CASE fill BetweenTabs OF 

tNoFill: 
BEGIN 
tyFill := tyFill Nil; 
chLdr := ORD(' '); 
END; 

tDot Fill: 
BEGIN 
tyFill := tyFill Dots; 
chLdr := ORD('.'); 
END; 

tHyphenFill: 
BEGIN 
tyFill := tyFill Hyph; 
chLdr := ORD('-') 
END; 

tUnderLineFill: 
BEGIN 
tyFill := tyFill UL; 
chLdr := ORD(' '); 
END; 

OTHERW SE 
BEGIN 
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001772 tyFill := tyFill Nil; 
001773 chLdr := ORD(' ') 
001774 END; 

001775 END; {CASE} 

001776 

001777 END; 

001778 {$R+} 

001779 END; 

001780 currentLpd*.rpe*,itbLim:= temp - 1; 
001781 {$1FC fTrce}EP; {$ENDC} 

001782 END; 

001783 

001784 

001785 {$lFC WthUObj ect} 

001786 {$8 TKUTMai n} 

001787 {$ELSEC} 

001788 {$$ UTMai n} 

001789 {$ENDC} 

001790 {ioLncneteteutee thatthe tice rds oie te iuers Dialect reeest eerie et oe cael 
001791 PROCEDURE {TUnivText. }ArgTbdToTabTabl e; 

001792 fei acer p eter elena oe ncaa ater aie eae el oe ined tira uate arene ee a eae a ety 
001793 VAR i: INTEGER 

001794 tab: TTabDescri ptor; 

001795 

001796 BEGIN 

001797 {$lFC fTraceUT} LogCall; {$ENDC} 

001798 {$IFC fTrce}BP( 11); {$ENDC} 

001799 { Size down the tab array for writing } 

001800 SELF. paragraphDescriptor.tabTable. Del Al| 

001801 FOR i := 0 to secrets.Ipd.rpe*.itbLim- 1 DO 

001802 BEGIN 

001803 {$R-} 

001804 WITH tab, secrets.Ipd.rpe*.argTbd[i] DO 

001805 BEGIN 

001806 position := x; 

001807 

001808 CASE quad OF 

001809 quadL: tabType := qLeftTab 

001810 quadC: tabType := qCenterTab; 

001811 quadR: tabType := qRightTab; 

001812 quad]: 1F fDecimal Comma THEN 

001813 tabType := qCommaTab 

001814 ELSE 

001815 tabType := qPeriodTab; 

001816 OTHERWISE tabType := qLeftTab; 

001817 END; {CASE} 

001818 

001819 CASE tyFill OF 
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001820 tyFill Nil: fill Betweentabs := tNoFill; 
001821 tyFill Dots: fill Betweentabs := tDotFill; 
001822 tyFill Hyph: fill Betweentabs := tHyphenFill; 
001823 tyFill UL: fill Betweentabs := tUnderLineFill: 
001824 OTHERW SE fill Betweentabs := tNoFill; 
001825 END; {CASE} 

001826 

001827 {$1 FC f Universal TextTrace} 

001828 IF fPrintSecrets THEN 

001829 BEGIN 

001830 WRITELN('Tab #', i + 1:0, ', tabType =', ORD(tabType):0, ', quad =', ORD(quad):0) 
001831 END; 

001832 {$ENDC} 

001833 END; 

001834 {$R+} 

001835 SELF. paragraphDescriptor.tabTable. I nsLast( @tab) 
001836 ND; 

001837 {$IFC fTrce}EP; {$ENDC} 

001838 END; 

001839 

001840 {$1FC WthUObj ect} 

001841 {$8 TKUTI nit} 

001842 {$ELSEC} 

001843 {$$ UTI nit} 

001844 {$ENDC} 

001845 BEGIN 

001846 {$lFC fTraceUT} LogCall; {$ENDC} 

001847 {$1 FC fUniversal Text Trace} 

001848 fPrintSecrets := FALSE: 

001849 {$ENDC} 

001850 END; 

001851 

001852 

001853 {$lFC WithUObj ect} 

001854 METHODS OF TTKReadUni vText 

001855 {$ELSEC} 

001856 METHODS OF TReadUni vText 

001857 {$ENDC} 

001858 

001859 {$l1FC WthUObj ect} 

001860 {$$ TKUTMai n} 

001861 {$ELSEC} 

001862 {$$ UTMai n} 

001863 {$ENDC} 

001864 fic cotann sear Gy eaten Sevan se cere ete Pi ebe land eee deaee se Geant nals Mee ae take aes 
001865 {$l1FC WthUObj ect} 

001866 FUNCTION {TReadUnivText. }CREATE( object: TObject; 
001867 itsHeap: THeap; 
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001868 itsTString: TString 

001869 itsDataSize: INTEGER; 

001870 Level OfGranul arity: TLevel Of Granul arity) 

001871 : TTKReadUni vText; 
001872 {$ELSEC} 

001873 FUNCTION {TReadUnivText. }CREATE(object: TUTObject; 

001874 itsHeap: THeap; 

001875 itsTString: TUTString 

001876 itsDataSize: INTEGER; 

001877 Level OfGranularity: TLevel Of Granul arity) 

001878 : TReadUnivText; 
001879 {$ENDC} 

001880 ogee ree ter ar eee ee er ee ee ee re eee ET ee re eee ee 
001881 VAR index: TB: 

001882 {$lFC WthUObj ect} 

001883 thisList: TString; 

001884 {$ELSEC} 

001885 thisList: TUTSt ring 

001886 {$ENDC} 

001887 BEGIN 

001888 {$l FC fTraceUT} LogCall; {$ENDC} 

001889 {$I FC fTrce}BP( 11); {$ENDC} 

001890 

001891 { Establish the level of granularity for reading } 

001892 WITH secrets.Ipd.tyset DO 

001893 BEGIN 

001894 frce := UTCharacters IN Level OfGranularity; 

001895 frpe := UTparagraphs IN Level OfGranul arity; 

001896 fParBnds := FALSE: 

001897 END; 

001898 

001899 Get CSScrap(i ndex) 

001900 1F index = 0 THEN 

001901 SELF := NIL 

001902 ELSE 

001903 BEGIN 

001904 secrets,streamArrayl ndex := index; 

001905 IF object = NIL THEN 

001906 {$lFC WthUObj ect} 

001907 object := NewObject(itsHeap, THI SCLASS) 

001908 {$ELSEC} 

001909 object := NewUTObject(itsHeap, THISCLASS); 

001910 {$ENDC} 
001911 

001912 {$l FC WthUObj ect} 
001913 SELF := TTKReadUni vText(TTKUnivText. CREATE(object, itsHeap, itsTString, itsDataSize)) 
001914 {$ELSEC} 

001915 SELF := TReadUnivText(TUnivText. CREATE(object, itsHeap, itsTString, itsDataSize)); 
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001916 {$ENDC} 


001917 

001918 {$l1FC WthUObj ect} 

001919 thisList := TString. CREATE(NIL, itsHeap, itsDataSi ze) 

001920 {$ELSEC} 

001921 thisList := TUTString.CREATE(NIL, itsHeap, itsDataSize) 

001922 {$ENDC} 

001923 thisList. StartEdit(50); {Allow holes} 

001924 SELF. buffer := thisList; 

001925 

001926 SELF. dataBeforeTab := TRUE: 

001927 SELF. Restart; { Set up for reading from the beginning} 
001928 END; 

001929 {$1FC fTrce}EP; {$ENDC} 

001930 END; 

001931 

001932 

001933 {$1 FC fDebugMet hods} 

001934 {$1FC WthUObj ect} 

001935 {$8 TKUTMain} 

001936 {$ELSEC} 

001937 {$$ UTMai n} 

001938 {$ENDC} 

001939 fe cimiectandlaahe praraianasn Siasmre mata ccncan at cean wu tce ae Gv iaraie adie aeonealacaceaecane Ceacmiabatia Baneon ae aeons ace waruod ewe mM ae emia bane 
001940 PROCEDURE {TReadUnivText. }Fields( PROCEDURE Field(nameAndType: $255)) 

001941 Pied estate acre Raden oeu carn pavaton a ae nan ace dale al cena a ada tec ee dactes Sk ed tac weer ee aereche ee eke alin cea 
001942 BEGIN 

001943 {$lFC fTraceUT} LogCall; {$ENDC} 

001944 SUPERSELF. Fields( Field); 

001945 {$l1FC WthUObj ect} 

001946 Field('buffer: TString'); 

001947 {$ELSEC} 

001948 Field(' buffer: TUTString'); 

001949 {$ENDC} 

001950 Field(''); 

001951 END; 

001952 {$ENDC} 

001953 

001954 

001955 {$l1FC WthUObj ect} 

001956 {$$ TKUTMai n} 

001957 {$ELSEC} 

001958 {$8 UTMai n} 

001959 {$ENDC} 

001960 Ste ee ee ee eee ee eee ee ee Lee eee re ere Cee ee Te ee eee re oe er eee eee ec rer 
001961 PROCEDURE {TReadUnivText. }Free 

001962 (suse Ueto soa ot eear ed Sa tduaa ee Seed tee eae ee buc owt cence Sue tena ecaa teense 
001963 BEGI N 
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001964 {$lFC fTraceUT} LogCall; {$ENDC} 

001965 {$1 FC fTrce}BP( 11); {$ENDC} 

001966 SELF. buffer. Free 

001967 SUPERSELF. Free 

001968 {$IFC fTrce}EP; {$ENDC} 

001969 END; 

001970 

001971 

001972 {$l1FC WthUObj ect} 

001973 {$8 TKUTMai n} 

001974 {$ELSEC} 

001975 {$8 UTMai n} 

001976 {$ENDC} 

001977 ee ee es ee ee ee ee ee ere rer Tee re rere ne ee ener Ee 
001978 PROCEDURE {TReadUnivText. }Restart:; 

001979 Fecssicsard ais Dinca a staiereatnitiere aes aide ox ane cate tade uaa toate pais yas einnans area Sle usle dab aul tate A muta at mlularel coal avons nla merece ea acl 
001980 BEGIN 

001981 {$lFC fTraceUT} LogCall; {$ENDC} 

001982 {$IFC fTrce}BP( 11); {$ENDC} 

001983 { Set up the Achad for reading fromthe beginning} 

001984 WITH secrets. achad DO 

001985 BEGIN 

001986 ichFst := 0; 

001987 ichLim:= SELF. data.size 

001988 END; 

001989 

001990 secrets.I pd. pLim:= 0; 

001991 

001992 SELF.columnCount := 0; 

001993 {$IFC fTrce}EP; {$ENDC} 

001994 END; 

001995 

001996 

001997 {$l1FC WthUObj ect} 

001998 {$8 TKUTMai n} 

001999 {$ELSEC} 

002000 {$$ UTMai n} 

002001 {$ENDC} 

002002 ee ee eer ee ery ere ere ee eee ee ee ee re eer re ee eer ee ee eee 
002003 PROCEDURE {TReadUnivText. }ScanTable(VAR rows, tabColumns, tabStopColumns: | NTEGER); 
002004 in ie ncan ieee ceca ata ened hn enacn aa Suahintddn, ReanS ia oho cla, ede cn, dead adc aray a Rsecda Ja Saco e esbee dle enter aiietaes dh a wldae dee hee dlabh mpeiakabtce a 
002005 VAR 

002006 fiel dOverfl ow: BOOLEAN 

002007 fieldTermi nator: CHAR 

002008 lastTermi nator: CHAR; 

002009 tabType: TTabTypes; 

002010 columns| nThisRow: INTEGER 

002011 dataBeforeTab: BOOLEAN 
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002012 
002013 
002014 
002015 
002016 
002017 
002018 
002019 
002020 
002021 
002022 
002023 
002024 
002025 
002026 
002027 
002028 
002029 
002030 
002031 
002032 
002033 
002034 
002035 
002036 
002037 
002038 
002039 
002040 
002041 
002042 
002043 
002044 
002045 
002046 
002047 
002048 
002049 
002050 
002051 
002052 
002053 
002054 
002055 
002056 
002057 
002058 
002059 


Apple Lisa Computer Technical Information 


BEGIN 
{$1 FC fTraceUT} LogCall; {$ENDC} 
rows := 0; 
tabColumns := 1; 


tabStopColumns := 0; 
columnsInThisRow : = {There is at least one column} 
SELF. dataBeforeTab := TRUE; {Make shure ReadField doesn't skip any fields} 


1; 
dataBeforeTab := FALSE; 


SELF. Restart; 
WHILE SELF. ReadField(1, fieldOverflow, fieldTerminator, tabType) DO 
BEGIN 
1F columnsi nThisRow = 1 THEN 
BEGIN 
IF SELF.data.size > 0 THEN 
dataBeforeTab := TRUE: 
IF tabStopColumns < SELF. paragraphDescriptor.tabTable.size THEN 
tabStopColumns := SELF. paragraphDescriptor.tabTable. size 
END; 
lastTerminatior := 
IF fieldTermi nator 
BEGIN 
rows := rows + 1; 
columnsIl nThisRow := 1; 
{Check the tab table here} 
END 
ELSE 
IF fieldTermi nator = CHR(chTab) THEN 
BEGIN 
columnsinThisRow := columnsl nThisRow + 1; 
1F columnsinThisRow > tabColumns THEN 
tabColumns := columns! nThisRow 
END; 


fieldTermi nator; 
= CHR(chCr) THEN 


END; 

SELF. Restart; 

1F (NOT dataBeforeTab) AND (tabColumn > 0) THEN 
tabColumns := tabColumns - 1; 

SELF. dataBeforeTab := dataBeforeTab; 


IF lastTerminatior <> CHR(chCr) THEN 
rows := rows + 1; 


{$IFC f Universal TextTrace} 
| F 


fPrintSecrets THEN 
BEGIN 
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002060 WRI TELN('ScanTable:'); 

002061 WRI TELN(' dataBeforeTab: : 

002062 WRI TELN(' tabCol umns: : 

002063 WRI TELN(' tabStopColumns: : 

002064 WRI TELN(' rows: j 

002065 END; 

002066 {$ENDC} 

002067 

002068 END; 

002069 

002070 

002071 {$l1FC WthUObj ect} 

002072 {$8 TKUTMai n} 

002073 {$ELSEC} 
{$ 
{$ 


, GdataBeforeTab); 
, tabColumns); 

, tabStopColumns); 
, Tows); 


002074 S UTMai n} 

002075 ENDC} 

002076 {(seteuuieuinieanneetakierieti testi ed eae etiags veh tee i alieanieeseehgoheds teed ia eek hes 
002077 FUNCTION {TReadUnivText. }ReadFi el d( maxFieldSize: INTEGER 
002078 VAR fieldOverflow: BOOLEAN 
002079 VAR fieldTermi nator: CHAR 
002080 VAR tabType: TTabTypes) 
002081 : BOOLEAN: 
002082 err Meret Core ere eT ee eT er eT eT eRe rT ere Tee Te ee erry Tee eT ere Nee Tee ee re eer re 
002083 {$l1FC WthUObj ect} 

002084 VAR data: TString 

002085 buffer: TString; 

002086 {$ELSEC} 

002087 VAR data: TUTString 

002088 buffer: TUTStri ng; 

002089 {$ENDC} 

002090 i: | NTEGER; 

002091 termi natorFound: BOOLEAN 

002092 result: BOOLEAN; 

002093 ol dSize: INTEGER; 

002094 newSi ze: INTEGER; 

002095 columnNr: INTEGER; 

002096 tab: TTabDescri ptor; 

002097 ch: CHAR; 

002098 

002099 PROCEDURE ReadBuffer; 

002100 BEGIN 

002101 SELF.data := buffer 

002102 SELF. ReadRun; 

002103 SELF.data := data; 

002104 END; 

002105 

002106 BEGIN 

002107 {$lFC fTraceUT} LogCall; {$ENDC} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 993 of 1012 


Apple Lisa Computer Technical Information 


002108 {$1 FC fTrce}BP( 11); {$ENDC} 

002109 

002110 

002111 REPEAT 

002112 buffer := SELF. buffer 

002113 data := SELF. data; 

002114 

002115 IF buffer.Size = 0 THEN { If there is no data then get some } 
002116 ReadBuf fer: 

002117 

002118 fieldTerminator := CHR(0) 

002119 fieldOverflow := FALSE: 

002120 

002121 data. Del All 

002122 termi natorFound := FALSE; 

002123 IF buffer.Size > 0 THEN { If there is still text to paste } 
002124 BEGIN 

002125 

002126 tabType := qleftTab; { Default tab type } 

002127 1F SELF.columnCount > 0 THEN 

002128 [F SELF.paragraphDescriptor.tabTable.size >= SELF.columnCount THEN 
002129 tabType := TTabDescri ptor( 

002130 SELF. paragraphDescri ptor.tabTable. At( SELF. col umnCount) 
002131 ).tabType; 

002132 SELF.columnCount := SELF.columnCount + 1; 

002133 columnNr := SELF.columnCount; 

002134 result := TRUE; 

002135 REPEAT 

002136 i := 0; 

002137 WHILE (i < buffer.Size) AND (NOT terminatorFound) DO 

002138 BEGIN 

002139 i:ei+1; 

002140 ch := buffer. At(i); 

002141 IF (ch = CHR(chTab)) OR (ch = CHR(chCr)) THEN 

002142 BEGIN 

002143 termi natorFound := TRUE; 

002144 fieldTermi nator := ch; 

002145 IF fieldTerminator = CHR(chCr) THEN 

002146 SELF.columnCount := 0: 

002147 END; 

002148 END; 

002149 

002150 oldSize := data. Size 

002151 newSize := oldSize t+ i 

002152 [F termi natorFound THEN { Hide the terminating character, if any } 
002153 newSize := newSize - 1; 

002154 

002155 IF newSize > maxFieldSize THEN 


Apple Lisa ToolKit 3.0 Source Code Listing -- 994 of 1012 


002156 
002157 
002158 
002159 
002160 
002161 
002162 
002163 
002164 
002165 
002166 
002167 
002168 
002169 
002170 
002171 
002172 
002173 
002174 
002175 
002176 
002177 
002178 
002179 
002180 
002181 
002182 
002183 
002184 
002185 
002186 
002187 
002188 
002189 
002190 
002191 
002192 
002193 
002194 
002195 
002196 
002197 
002198 
002199 
002200 
002201 
002202 
002203 
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BEGIN 

newSize := maxFieldSize 
fieldOverflow := TRUE; 
END; 


IF newSize > oldSize THEN 
data. I nsManyAt(1 + data.size, buffer, 1, newSize - oldSize) 


buffer. Del ManyAt(1, i); 
1F (NOT terminatorFound) AND (buffer.Size = 0) THEN 
ReadBuf fer; 
UNTIL termi natorFound OR (buffer. Size = 0); 


{$1 FC fUniversal TextTrace} 
IF fPrintSecrets THEN 


BEGIN 
WRI TELN('Buffer size is ',buffer.Size:1, ' data size is ',data.size:1) 
FOR i := 1 to data.size DO 


WRI TE( data. At(i)); 
1F fieldTerminator = CHR(chTab) THEN 
WRI TE(' <Tab>' ) 
ELSE 
IF fieldTerminator = CHR(chCr) THEN 
WRI TE(' <Cr>') 
ELSE 
WRITE('<End of paste>'); 
WRI TELN: 
WRI TELN('FieldOverflowis ', fieldOverfl ow); 
END; 
{$ENDC} 
END 
ELSE 
result := FALSE: 
UNTIL (NOT result) OR (columnNr > 1) OR SELF. dataBeforeTab; 
ReadField := result; 


{$IFC fTrce}EP; {$ENDC} 
END; 


{$1 FC WithUObj ect } 
{$$ TKUTMai n} 
{$ELSEC} 

{$$ UTMai n} 
{$ENDC} 


FUNCTION {TReadUnivText. }ReadLi ne( maxLineSize: INTEGER; 
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002204 VAR lineOverflow: BOOLEAN; 
002205 VAR lineTermi nator: CHAR) 
002206 : BOOLEAN: 
002207 ere eer rT eet ert ee CET ee ETE Teer Tere Ter Tee Tere r reer ee CT eee eee eee Cee Ce ee ce 
002208 {$l1FC WthUObj ect} 

002209 VAR data: TString; 

002210 buffer: TString; 

002211 {$ELSEC} 

002212 VAR data: TUTString; 

002213 buffer: TUTString; 

002214 {$ENDC} 

002215 i: INTEGER; 

002216 termi natorFound: BOOLEAN; 

002217 ol dSize: INTEGER; 

002218 newSi ze: INTEGER; 

002219 ch: CHAR; 

002220 

002221 PROCEDURE ReadBuf fer; 

002222 BEGIN 

002223 {$lFC fTraceUT} LogCall; {$ENDC} 

002224 SELF.data := buffer; 

002225 SELF. ReadRun; 

002226 SELF. data := data; 

002227 END; 

002228 

002229 BEGIN 

002230 {$lFC fTraceUT} LogCall; {$ENDC} 

002231 {$I FC fTrce}BP( 11); {$ENDC} 

002232 buffer := SELF. buffer; 

002233 data := SELF. data; 

002234 

002235 IF buffer.Size = 0 THEN { If there is no data then get some } 
002236 ReadBuf fer; 

002237 

002238 lineTermi nator := CHR(0); 

002239 lineOverflow := FALSE; 

002240 

002241 data. Del All; 

002242 termi natorFound := FALSE; 

002243 IF buffer. Size > 0 THEN { If there is still text to paste } 
002244 BEGIN 

002245 ReadLine := TRUE; 

002246 REPEAT 

002247 i := 0; 

002248 WHILE (i < buffer.size) AND (NOT terminatorFound) DO 
002249 BEGIN 

002250 irs=i¢t+l 

002251 ch := buffer. At(i); 
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002252 IF ch = CHR(chCr) THEN 

002253 BEGIN 

002254 termi natorFound := TRUE: 

002255 lineTerminator := ch; 

002256 END; 

002257 END; 

002258 

002259 oldSize := data. Size 

002260 newSize := oldSize ¢+ i 

002261 [F termi natorFound THEN { Hide the terminating character, if any } 
002262 newSize := newSize - 1; 

002263 

002264 IF newSize > maxLineSize THEN 

002265 BEGIN 

002266 newSize := maxLineSize 

002267 lineOverflow := TRUE; 

002268 END: 

002269 

002270 IF newSize > ol dSize THEN 

002271 data. I nsManyAt(1 + data.size, buffer, 1, newSize - oldSize) 
002272 

002273 buffer. Del ManyAt(1, i); 

002274 

002275 1F (NOT terminatorFound) AND (buffer. Size = 0) THEN 
002276 ReadBuf fer 

002277 UNTIL termi natorFound OR (buffer. Size = 0) 
002278 

002279 {$1 FC fUniversal TextTrace} 

002280 IF fPrintSecrets THEN 

002281 BEGIN 

002282 WRITELN(' Buffer size is ',buffer.Size:1, ' data size is ',data.size:1) 
002283 FOR i := 1 to data.size DO 

002284 WRI TE( data. At(i)); 

002285 IF lineTerminator = CHR(chCr) THEN 

002286 WRI TE(' <Cr>') 

002287 ELSE 

002288 WRI TE('<End of paste>') 

002289 WRI TELN 

002290 WRITELN('LineOverflow is ', lineOverfl ow); 
002291 END; 

002292 {$ENDC} 

002293 END 

002294 ELSE 

002295 ReadLine := FALSE; 

002296 

002297 {$IFC fTrce}EP; {$ENDC} 

002298 END: 

002299 
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002300 

002301 {$1FC WthUObj ect} 

002302 {$$ TKUTMain} 

002303 {$ELSEC} 

002304 {$$ UTMai n} 

002305 {$ENDC} 

002306 er er ee Tere ee eT eee TEE eR eee OSE CR ee Oe Oe ene ene Pee Cone Ce ee Te 
002307 PROCEDURE {TReadUni vText. }ReadRun: 

002308 ee errr ee ere ee ee ee ee Se ee re ree eee ee ee ee er eae 
002309 VAR error: INTEGER 

002310 size: LONGI NT; 

002311 

002312 BEGIN 

002313 {$lFC fTraceUT} LogCall; {$ENDC} 

002314 {$1 FC fTrce}BP( 11); {$ENDC} 

002315 Bi ndUTDSeg( error) 

002316 

002317 { Size up the tab and data arrays to take the next run } 
002318 SELF. data. Del Al | 

002319 SELF. data. EditAt(1, SELF. maxDataSi ze) 

002320 

002321 { Set the achad to receive the next run } 

002322 WITH secrets. achad DO 

002323 BEGIN 

002324 rgch := POINTER( SELF. data. Addr Member(1)); 

002325 ichFst := 0; 

002326 ichLim:= SELF. maxDataSize 

002327 END; 

002328 

002329 WITH secrets DO 

002330 REPEAT 

002331 { Get the next run } 

002332 1F | pd.lplim = 0 THEN 

002333 SetLpd(@Lpd, streamArraylndex, 0, Ipd.Tyset, achad) 
002334 ELSE 

002335 Seql pd(@pd, achad) 

002336 UNTIL (NOT Ipd.rce*.fvan) OR (achad.ichFst = achad.ichLim) 
002337 

002338 {$I FC f Universal TextTrace} 

002339 IF fPrintSecrets THEN 

002340 PrintSecrets(secrets.achad, secrets.I pd); 

002341 {$ENDC} 

002342 

002343 { Convert to Run } 

002344 SELF. StreamToRun: 

002345 WITH secrets.Ipd DO 

002346 BEGIN 

002347 IF tyset.fRpe THEN 


Apple Lisa ToolKit 3.0 Source Code Listing -- 998 of 1012 


Apple Lisa Computer Technical Information 


002348 size := |pLimPar - Ip {LSR: changed I pFstPar to |p} 
002349 ELSE 

002350 size := I|plLim~ Ip; 

002351 

002352 IF size > (I pLimlp) THEN 

002353 size := |plLim~ Ip; 

002354 

002355 [plLim:= Ip + size 

002356 END; 

002357 IF size < SELF.data.size THEN 

002358 SELF. data. Del ManyAt(size + 1, SELF.data.size - size) 
002359 

002360 UnBi ndUTDSeg(error); 

002361 {$1FC fTrce}EP; {$ENDC} 

002362 END; 

002363 

002364 

002365 {$l1FC WthUObj ect} 
002366 {$8 TKUTMain} 

002367 {$ELSEC} 

002368 {$8 UTMai n} 

002369 {$ENDC} 

002370 errr erat Cer eT eT Tree TT eRe ere eer ere er rr ee ere ET RN EEN ETT ee eee ere ere roe 
002371 FUNCTION {TReadUnivText. }GetParaPicture(heap: THeap) : PicHandle; 

002372 ence re ee er eee err ee eer ee eet ee ee ee eer ee ee et ee ee eer eer 
002373 BEGI N 

002374 {$lFC fTraceUT} LogCall; {$ENDC} 

002375 {$I1FC fTrce}BP( 11); {$ENDC} 

002376 GetParaPicture := NIL: 

002377 {$IFC fTrce}EP; {$ENDC} 

002378 END; 

002379 

002380 {$l1FC WthUObj ect} 

002381 {$8 TKUTI nit} 

002382 {$ELSEC} 

002383 {$8 UTI nit} 

002384 {$ENDC} 

002385 END; 

002386 

002387 

002388 {$l1FC WthUObj ect} 

002389 METHODS OF TTKWriteUnivText 
002390 {$ELSEC} 

002391 METHODS OF TWriteUni vText 
002392 {$ENDC} 

002393 

002394 {$1FC WthUObj ect} 

002395 {$S TKUTWrite} 


Apple Lisa ToolKit 3.0 Source Code Listing -- 999 of 1012 


Apple Lisa Computer Technical Information 


002396 {$ELSEC} 
002397 {$$ UTWrite} 
002398 {$ENDC} 


002399 Meer eee ee ere ety eer eT ee eT EST eer T er eT ee re err eee ee eT eee eee ey eee ee Cer ee ce 
002400 {$l1FC WthUObj ect} 

002401 FUNCTION {TWriteUnivText. }CREATE(obj ect: TObj ect 

002402 itsHeap: THeap; 

002403 itsTString: TString 

002404 itsDataSize: | NTEGER) 

002405 : TTKWiteUnivText; 
002406 {$ELSEC} 

002407 FUNCTION {TWriteUnivText. }CREATE( object: TUTObj ect; 

002408 itsHeap: THeap; 

002409 itsTString: TUTString; 

002410 itsDataSize: INTEGER) 

002411 : TWriteUnivText; 
002412 {$ENDC} 

002413 Mtr ee ert eee eT ee eT Ere e NT eee CERT eT ree er Tere Eee Ter Nee eee Ce ee eee Te errr er re Tee 
002414 VAR 

002415 ptrTool Kit UT: TPtrTool Kit UT; 

002416 error: INTEGER; 

002417 index: TB; 

002418 

002419 {$I1FC PasteTrace} 

002420 dbgCh: CHAR: 

002421 {$ENDC} 

002422 

002423 BEGIN 

002424 {$I1FC PasteTrace} 

002425 WRITE('Do you want to debug (Y/N): ') 

002426 READ( dbgCh) 

002427 fPrintSecrets := dbgCh IN ['Y', ‘y'] 

002428 {$ENDC} 

002429 

002430 {$lFC fTraceUT} LogCall; {$ENDC} 

002431 {$I FC fTrce}BP( 11); {$ENDC} 

002432 Bi ndUTDseg( error) 

002433 1F error <> 0 THEN 

002434 ABCBreak('BindUTDseg Error',error); 

002435 

002436 index := IcsCreate(tycsFld, SIZEOF( Tool KitUT), POI NTER(ORD(itsHeap))) 
002437 {$R- } 

002438 ptrTool KitUT := POINTER( rghcs*[index]% ) 

002439 {$R+} 

002440 WITH secrets DO 

002441 BEGIN 

002442 streamArrayl ndex := index; 

002443 Ipd.tyset.fRpe := TRUE; 
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002444 Ipd.tyset.fRce := TRUE; 

002445 END; 

002446 

002447 WITH ptrTool KitUT* DO 

002448 BEGIN 

002449 cspd.argproc[|ProcSeqLpd] := @SeqLpdUTBB; 

002450 cspd.argproc[|ProcFreelcs] := Pointer(procnil); 

002451 cspd.argproc[{|ProcPxHcs] := Pointer(procnil) 

002452 cspd.argproc[| ProcFindLpFixed] := @FindLpFstPar 

002453 cspd.argproc[| ProcFSelLpBounds] := @TrueStdSel LpBounds 
002454 END; 

002455 

002456 secrets,streamsrrayl ndex := index; 

002457 

002458 nOfSavedPara := 0; {Nothing in the backLogBuf fer} 
002459 dataLp := 0; {Starting | pd} 
002460 

002461 IF object = NIL THEN 

002462 {$lFC WthUObj ect} 

002463 object := NewObject(itsHeap, THISCLASS) 

002464 {$ELSEC} 

002465 object := NewUTObject(itsHeap, THISCLASS); 

002466 {$ENDC} 

002467 

002468 {$l FC WthUObj ect} 

002469 SELF := TTKWriteUnivText(TTKUnivText. CREATE(object, itsHeap, itsTString, itsDataSize)) 
002470 {$ELSEC} 

002471 SELF := TWriteUnivText(TUnivText.CREATE(object, itsHeap, itsTString, itsDataSize)); 
002472 {$ENDC} 

002473 

002474 { Get a default UT character and paragraph descriptors } 
002475 WITH secrets DO 

002476 BEGIN 

002477 Ipd.rpe := @pd.arpe 

002478 {$H-} moveRgch(@pd.arpe, @arpeStd, arpeStd.cbh); {$H+} 
002479 

002480 Lpd.rce := @pd.arce 

002481 {$H-} moveRgch( pointer(ord(Ipd.rce)), @arceStd, arceStd.cbh); {$H+} 
002482 END; 

002483 

002484 SELF. StreamToRun: 

002485 

002486 activeStream:= SELF: 

002487 SELF. data. Del Al | 

002488 

002489 StartGetScrap(error); 

002490 IF error <> 0 THEN 

002491 ABCBreak('StartGetScrap Error’, error) 
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002492 

002493 PutCsScrap(index, error); 

002494 IF error <> 0 THEN 

002495 ABCBreak('PutCsScrap Error',error); 
002496 

002497 freeics(index); 

002498 

002499 EndGetScrap(error); 

002500 IF error <> 0 THEN 

002501 ABCBreak('EndGetScrap Error', error) 
002502 

002503 Unbi ndUTDseg( error); 

002504 IF error <> 0 THEN 

002505 ABCBreak('UnbindUTDseg Error’, error) 
002506 {$1FC fTrce}EP; {$ENDC} 

002507 END; 

002508 

002509 

002510 {$l1FC WthUObj ect} 

002511 {$8 TKUTWrite} 

002512 {$ELSEC} 

002513 {$8 UTWrite} 

002514 {$ENDC} 

002515 one eee ee eee eee eee ee ee ee ee ee eee ee ee ee eee ee 
002516 PROCEDURE {TWriteUnivText. }Fill Paragraph; 
002517 {ise x har aidcecere aoe aieasele nee ater keane ee area ww aerate ww dleea Sacre CEE aie ee ee ae eet 
002518 BEGI N 

002519 {$lFC fTraceUT} LogCall; {$ENDC} 

002520 {$1FC fTrce}BP( 11); {$ENDC} 

002521 {$l1FC WthUObj ect} 

002522 ABCBreak(' Failed to reimplement TTKWriteUnivText. Fill Paragraph’, 0) 
002523 {$ELSEC} 

002524 ABCBreak('Failed to reimplement TWriteUnivText. Fill Paragraph’, 0) 
002525 {$ENDC} 

002526 {$IFC fTrce}EP; {$ENDC} 

002527 END; 

002528 

002529 {$l1FC WthUObj ect} 

002530 {$8 TKUTI nit} 

002531 {$ELSEC} 

002532 {$8 UTI nit} 

002533 {$ENDC} 

002534 END; 


End of File -- Lines: 2534 Characters: 79766 
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FILE: 


“UFIXUTEXT. TEXT" 


000001 
000002 
000003 
000004 
000005 
000006 
000007 
000008 
000009 
000010 
000011 
000012 
000013 
000014 
000015 
000016 
000017 
000018 
000019 
000020 
000021 
000022 
000023 
000024 
000025 
000026 
000027 
000028 
000029 
000030 
000031 
000032 
000033 
000034 
000035 
000036 
000037 
000038 
000039 
000040 
000041 
000042 
000043 


UNIT UFixUText; 


{This unit fixes a bug with UText, where pasting universal text containing a 14 Point or 
20 Pitch font would crash with a check range error, accessing the uvFont array. The 

e in TinsertionPoint.InsertText. To fix the problem we subclass 

ertText, but install a pointer to the revised method in TinsertionPoint's 


only access was mad 
Tl nsertionPoint.Ins 
method table. } 


{$SETC CalcNumbers := FALSE} {IF TRUE, calculate level/ method numbers 


{$SETC Debug := FALSE} 
INTERFACE 


{$E ERRORS} 
{$E+} 


USES 

{$U LI BPL/ UCLASCAL} 
{$U UObj ect} 

{$U QuickDraw} 

{$U UDraw} 

{$U UABC} 

{$U UUnivText } 

{$U UText} 


TYPE 
TFi xi nserti onPoi nt 


FUNCTION TFixl 
PROCEDURE TFi xl 


END; 
| MPLEMENTATI ON 


{$1 FC fSymOK AND Debug} 


{$D+} 
{$ELSEC} 


Apple 


UCl ascal 

UObj ect, 

Qui ckDraw 

UDraw, 

UABC, 

UTKUni versal Text, 
UText; 


= SUBCLASS OF Tl nserti onPoi nt 
nsertionPoint. CREATE: TFixlnsertionPoint; ABSTRACT; 
nsertionPoint.I nsertText(text: TText; isParaSel ection: 


isWordSelection: BOOLEAN 
universal Text: BOOLEAN); 
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else use CONSTs} 


BOOLEAN; 
OVERRI DE; 
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000044 
000045 
000046 
000047 
000048 
000049 
000050 
000051 
000052 
000053 
000054 
000055 
000056 
000057 
000058 
000059 
000060 
000061 
000062 
000063 
000064 
000065 
000066 
000067 
000068 
000069 
000070 
000071 
000072 
000073 
000074 
000075 
000076 
000077 
000078 
000079 
000080 
000081 
000082 
000083 
000084 
000085 
000086 
000087 
000088 
000089 
000090 
000091 
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$ 
$ 
$ 
$R+} 
$ 
$ 


VAR uvFont: ARRAY[1..19] OF TFontRecord 


cFixlnsertionPoint: TClass: 


{$8 FixText1} {Caller and HackMethodTable must be in the same segment} 


{$l FC Cal cNumbers} 
PROCEDURE Caller; 

VAR ip: Tl nsertionPoi nt; 

t: TText; 

BEGIN 

ip.InsertText(t, TRUE, TRUE, TRUE); 
END; 
{$ENDC} 


PROCEDURE HackMet hodTabl es 
{$l FC CalcNumbers AND DEBUG} 
LABEL 1,100; 
{$ELSEC} 
{$1 FC Cal cNumbers } 
LABEL 100; 
{$ENDC} 
{$1 FC Debug} 
LABEL 1; 
{$ENDC} 
{$ENDC} 


{$l FC NOT Cal cNumbers } 
CONST 

levNum 

met hNum 


{$ENDC} 


TYPE 
TMethodArray = ARRAY [1..256] OF LONGINT; 
TPMethodArray = “TMethodArray; 


TSliceTable = ARRAY [0..255] OF TPMethodArray; 
TPSliceTable = *TSliceTable; 
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000092 

000093 VAR myProc: LONGI NT; 
000094 {$I FC Cal cNumbers } 

000095 pe: Tpl nteger; 
000096 wd: INTEGER; 
000097 levNum: INTEGER; 
000098 met hNum: INTEGER 
000099 {$ENDC} 

000100 pSliceTable: TpSliceTable; 
000101 


000102 BEGIN 

000103 {$IFC Debug} 
000104 1: GOTO 1; 
000105 {$ENDC} 


000106 

000107 {$1FC Cal cNumbers} 

000108 {Find out the method # & level # for TlnsertionPoint.I nsertText} 
000109 pe := Tplnteger(@Caller); 

000110 WHILE ORD(pc) <= ORD( @HackMethodTables) DO 

000111 BEGIN 

000112 wd := pc* 

000113 pe := Tplnteger(ORD( pc) +2); 

000114 1F wd = $4695 THEN {JSR (A5) } 

000115 BEGIN 

000116 wd := pc’; {get level/ method # as an integer} 
000117 levNum:= wd DIV 256; {these 2 statements only work for <128 levels} 
000118 methNum := wd MOD 256 

000119 {$1FC Debug} 

000120 WriteLn(levNum, methNum); {***} 

000121 {$ENDC} 

000122 GOTO 100; 

000123 END; 

000124 END; 

000125 HALT; {did not find the method call} 

000126 100: 

000127 {$ENDC} 

000128 

000129 pSliceTable := TpSliceTable(cFixlnserti onPoi nt); 

000130 myProc := pSliceTable*[] evNum] *[ met hNum] 

000131 

000132 {The superclass pointers have not been installed yet, so need to use the arrays in UClascal.} 
000133 pSliceTable := TpSliceTabl e( pSTables*[pCl asses *[numCl asses]. superl ndex]) 
000134 pSliceTable*[levNum] *[methNum] := myProc 

000135 END; 

000136 

000137 METHODS OF TFixInsertionPoi nt; 

000138 


000139 {$$ FixText2} 
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000140 
000141 
000142 
000143 
000144 
000145 
000146 
000147 
000148 
000149 
000150 
000151 
000152 
000153 
000154 
000155 
000156 
000157 
000158 
000159 
000160 
000161 
000162 
000163 
000164 
000165 
000166 
000167 
000168 
000169 
000170 
000171 
000172 
000173 
000174 
000175 
000176 
000177 
000178 
000179 
000180 
000181 
000182 
000183 
000184 
000185 
000186 
000187 
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PROCEDURE TFixlInsertionPoint.InsertText(text: TText; 


VAR s: TListScanner; 
prevPara: TEdit Para; 
newPara: TEdit Para; 
aParagraph: TEdit Para; 
newLP: INTEGER; 
textl mage: TTextl mage 
insertit: BOOLEAN 
done: BOOLEAN; 
newParal mage: TParal mage 
paral ndex: LONGI NT; 
delta: INTEGER 
numParas: INTEGER 
needSpRi ght: BOOLEAN 


{$I FC fUseUni vText } 
readUnivText: TTKReadUni vText; 


univPara: TEdit Para; 
univFormat: TParaFor mat; 
{$ENDC} 


PROCEDURE Start Paste 

BEGIN 
{$I FC fTrace}BP(10); {$ENDC} 
IF universal Text THEN 


isParaSelection: BOOLEAN; isWordSelection: BOOLEAN 
universalText: BOOLEAN) 


:= TParaFormat. CREATE(NIL, SELF.Heap, SELF. textl mage. text. styl eSheet); 


BEGIN 

{$1 FC fUseUni vText} 

uni vFor mat 

univPara := textl mage. NewEditPara(0, prevPara. format); 


readUni vText 


numParas := 0; 
{$ENDC} 
END 
ELSE 
BEGIN 
numParas := text. paragraphs. size 


s := text. paragraphs. Scanner 


END; 
{$1 FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE EndPaste; 
BEGIN 
{$1 FC fTrace}BP(10); {$ENDC} 
IF universal Text THEN 
BEGIN 
{$I FC fUseUni vText} 
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:= TTKReadUnivText. CREATE(NIL, SELF.Heap, NIL, 512, 


[UTCharacters, UTParagraphs]); 
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000188 uni vPara. Free; 

000189 readUni vText. Free; 

000190 {$ENDC} 

000191 END; 

000192 {$1 FC fTrace}EP; {$ENDC} 

000193 END; 

000194 

000195 FUNCTION Get Paragraph( VAR paragraph: TEditPara): BOOLEAN; 
000196 VAR currPos: INTEGER; 

000197 done: BOOLEAN; 

000198 runSi ze: INTEGER; 

000199 wasSomeText: BOOLEAN; 

000200 ch: CHAR; 

000201 typeStyle: TTypeStyle; 

000202 BEGIN 

000203 {$1 FC fTrace}BP(10); {$ENDC} 

000204 lf universal Text THEN 

000205 BEGIN 

000206 {$I FC fUseUni vText} 

000207 univPara. Repl PString(0, univPara.Size, NIL); 
000208 currPos := 0; 

000209 wasSomeText := FALSE; 

000210 done := FALSE; 

000211 REPEAT 

000212 readUni vText. ReadRun; 

000213 runSize := readUnivText. data. size; 

000214 IF runSize > 0 THEN 

000215 BEGIN 

000216 1F NOT wasSomeText THEN 

000217 BEGIN 

000218 WITH univFormat, readUnivText. paragraphDescriptor DO 
000219 BEGIN 

000220 firstIndent := firstLineMargin; 
000221 leftindent := bodyMargin; 
000222 (* Can't use this because it's given as distance fromleft rather than 
000223 indent fromright and | don't know what value of right edge of paper is. 
000224 rightI ndent := rightMargin; 
000225 *) 

000226 spaceBelowPara := paraLeading; 
000227 END; 

000228 univPara. format := univFormat; 
000229 END; 

000230 wasSomeText := TRUE; 

000231 ch := readUnivText. data. At(runSize); 
000232 IF ORD(ch) = ascReturn THEN 

000233 BEGIN 

000234 readUnivText. data. Del At(runSize); 
000235 runSize := runSize - 1; 
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000236 
000237 
000238 
000239 
000240 
000241 
000242 
000243 
000244 
000245 
000246 
000247 
000248 
000249 
000250 
000251 
000252 
000253 
000254 
000255 
000256 
000257 
000258 
000259 
000260 
000261 
000262 
000263 
000264 
000265 
000266 
000267 
000268 
000269 
000270 
000271 
000272 
000273 
000274 
000275 
000276 
000277 
000278 
000279 
000280 
000281 
000282 
000283 
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numParas := numParas + 1; 

done := TRUE; 

END; 
univPara. Repl TString(currPos, 0, readUnivText. data, 0, runSize); 
typeStyle.onFaces := readUnivText.characterDescriptor.face 


typeStyle.font.fontFamily := uvFont[readUnivText. characterDescri ptor.font].fontFamil y; 
typeStyle.font.fontSize := uvFont[readUnivText.characterDescri ptor. font]. fontSize 


univPara. NewStyle(currPos, currPostrunSize, typeStyle) 
currPos := currPos + runSize 
END 
ELSE 
BEGIN 
IF wasSomeText THEN 
numParas := numParas + 1; 
done := TRUE; 
END; 
UNTIL done: 
1F wasSomeText THEN 
paragraph := univPara 
ELSE 
paragraph := NIL; 
Get Paragraph := wasSomeText; 
{$ELSEC} 
paragraph := NIL; 
Get Paragraph := FALSE; 
{$ENDC} 
END 
ELSE 
Get Paragraph := s.Scan(paragraph); 
{$1 FC fTrace}EP; {$ENDC} 
END; 


PROCEDURE I nsText; 

BEGIN 
{$1 FC fTrace}BP(10); {$ENDC} 
delta := 0: 
textl mage := SELF. textl mage 
newLP := SELF. textRange.firstLP 


newPara := SELF.textRange. first Para; 
prevPara := newPara; 
insertit := FALSE; 


1F isWordSelection THEN 
BEGIN 
needSpRi ght := newPara. Quali fies(newLP) 
IF newPara. Qualifies(newLP-1) THEN 
BEGIN 
newPara.I nsertOneChar(' ', newLP); 
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000284 newLP := newLP + 1: 

000285 delta := 1: 

000286 END; 

000287 END; 

000288 

000289 (* {special case: if first paragraph in text is designated a whole paragraph (by isParaSelection) AND 
000290 if the insertion point (SELF) is at the end of the paragraph then we want to make a new 
000291 paragraph rather than append it to the current paragraph and consequently set the flag that 
000292 was supposed to prevent the first paragraph from being inserted} 

000293 IF isParaSelection AND (prevPara.size = newLP) THEN 

000294 BEGIN 

000295 newPara := textl mage. NewEditPara(0, prevPara. format) 

000296 newLP := 0; 

000297 insertlt := TRUE: 

000298 END; 

000299 *) 

000300 done := FALSE; 

000301 Start Paste; 

000302 [F GetParagraph(aParagraph) THEN 

000303 BEGIN 

000304 delta := delta + aParagraph. size 

000305 REPEAT 

000306 newPara. Repl Para(newLP, 0, aParagraph, 0, aParagraph. size) 

000307 newLP := newLP + aParagraph. size 

000308 IF insertlt THEN 

000309 textl mage.text.InsParaAfter(prevPara, newPara) 

000310 insertilt := TRUE: 

000311 prevPara := newPara; 

000312 1F GetParagraph(aParagraph) THEN 

000313 BEGIN 

000314 newPara := textl mage. NewEdit Para(prevPara.size-newLP 

000315 TParaFormat(aParagraph. format. Cl one( SELF. Heap) )); 
000316 {For now, so we don't get garbage (if aParagraph later deleted), put cloned 
000317 format on to styleSheet list} 

000318 SELF. text! mage. text.styl eSheet. formats. | nsLast(newPara. format) 

000319 newPara. StartEdit(newPara. GrowSi ze) 

000320 newPara. Repl Para(0, 0, prevPara, newLp, prevPara.size - newLp) 

000321 prevPara. Repl PString(newLp, prevPara.size-newLP, NIL) 

000322 prevPara, StopEdit; 

000323 newLP := 0; 

000324 END 

000325 ELSE 

000326 done := TRUE; 

000327 UNTIL done: 

000328 END; 

000329 

000330 IF isParaSelection THEN 

000331 BEGIN 
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000332 newPara := textl mage. NewEditPara(prevPara.size - newLP, prevPara.format); 
000333 newPara. StartEdit(newPara. GrowSi ze) 

000334 newPara. Repl Para(0, 0, prevPara, newLp, prevPara.size - newLp) 
000335 prevPara. Repl PString(newLp, prevPara.size - newLP, NIL) 
000336 prevPara. StopEdit; 

000337 textl mage. text.I nsParaAfter(prevPara, newPara) 

000338 newPara := TEditPara(textl mage. text. paragraphs. At(SELF.textRange.firstIndex + numParas)); 
000339 numParas := numParas+l; 

000340 newLP := 0; 

000341 END 

000342 ELSE IF isWordSelection THEN 

000343 IF needSpRight THEN 

000344 BEGIN 

000345 newPara.InsertOneChar(' ', newLP); 

000346 newLP := newLP + 1: 

000347 delta := delta + 1; 

000348 END: 

000349 

000350 EndPaste; 

000351 {$1 FC fTrace}EP; {$ENDC} 

000352 END; 

000353 

000354 PROCEDURE Adj ust; 

000355 PROCEDURE AddDelta( paral mage: TParal mage); 

000356 BEGIN 

000357 paral mage. Adj ustLineLPs(SELF.textRange.firstLP, delta) 
000358 END; 

000359 BEGIN 

000360 {$1 FC fTrace}BP(10); {$ENDC} 

000361 SELF. text Range. first Para. Eachl mage( AddDel ta) 

000362 

000363 WITH SELF, textRange DO 

000364 BEGIN 

000365 firstPara := newPara; 

000366 lastPara := newPara; 

000367 firstLP := newLP; 

000368 lastLP := newLP 

000369 firstindex := firstlndex + numParas - 1: 

000370 lastI ndex := firstindex; 

000371 newestLP := newLP 

000372 amTyping := FALSE; 

000373 END; 

000374 {$1 FC fTrace}EP; {$ENDC} 

000375 END; 

000376 BEGIN 

000377 {$IFC fTrace}BP(11); {$ENDC} 

000378 IF (text <> NIL) OR universal Text THEN 

000379 SELF. ChangeText(InsText, Adjust); 
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000380 
000381 
000382 


000383 {$8 


END; 


Fi xText1} 


000384 BEGIN 
cFixilnsertionPoint := 


000385 
000386 
000387 
000388 
000389 
000390 
000391 
000392 
000393 
000394 
000395 
000396 
000397 
000398 
000399 
000400 
000401 
000402 
000403 
000404 
000405 
000406 
000407 
000408 
000409 
000410 
000411 
000412 
000413 
000414 
000415 
000416 
000417 
000418 
000419 
000420 
000421 


END; 


END. 


End of File -- 
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HackMet hodTabl es 


uvFont[4]. 
uvFont[5]. 
uvFont[6]. 
uvFont[7]. 
uvFont[8]. 
uvFont[9]. 
uvFont[10] 


uvFont[11]. 


uvFont[12] 


uvFont[13]. 
uvFont[14]. 
uvFont[15]. 
uvFont[16]. 


uvFont[19] 
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THI 


f 
f 
f 
f 
f 
f 


FWD OO I OT TT Tt Tr te 


421 Characters: 


number of files : 38 


{$I1FC fTrace}EP; {$ENDC} 


SCLASS; 


amModern; 
amModern; 
amModern; 
amModern; 
amModern; 
amModern; 
famClassic; 
famClassic: 
famClassic; 
famClassic; 
famClassic; 
famModern; 
famClassic; 
famModern; 


13961 


{added} 
{added} 
{added} 


{added} 
{added} 
{added} 
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